=
BEGIN
ROPE: TYPE ~ Rope.ROPE;
RopePair: TYPE ~ RECORD [name, value: ROPE];
Scanner: TYPE ~ REF ScannerRep;
ScannerRep:
TYPE ~
RECORD [
stream: IO.STREAM,
tokenKind: Kind,
inputBuffer: REF TEXT,
locationOfBufferStart: INT,
identifierScratch: REF TEXT,
tokenStart: NAT,
tokenLength: NAT
];
inputBufferSize: NAT ← 1024;
identifierScratchSize: NAT ← 120;
CreateScanner:
PROC [stream:
IO.
STREAM]
RETURNS [scanner: Scanner] ~ {
scanner ←
NEW[ScannerRep ← [
stream: stream,
tokenKind: whitespace,
inputBuffer: NEW[TEXT[inputBufferSize]],
locationOfBufferStart: IO.GetIndex[stream],
identifierScratch: NEW[TEXT[identifierScratchSize]],
tokenStart: 0,
tokenLength: 0
]];
};
Kind: TYPE ~ {identifier, special, whitespace, newline, eof};
KindOf:
PROC [c:
CHAR]
RETURNS [Kind] ~ {
SELECT c
FROM
IN ['a..'z], IN ['A..'Z], IN ['0..'9], '$ => RETURN [identifier];
Ascii.SP, Ascii.TAB, Ascii.LF => RETURN [whitespace];
Ascii.CR => RETURN [newline];
ENDCASE => RETURN [special];
};
breakLoc: INT ← LAST[INT];
GetToken:
PROC [scanner: Scanner] ~ {
Gets the next token into inputBuffer[tokenStart] .. inputBuffer[tokenLength-1]
scanner.tokenStart ← scanner.tokenStart+scanner.tokenLength;
scanner.tokenLength ← 0;
IF scanner.tokenStart>=scanner.inputBuffer.length THEN RefillBuffer[scanner];
IF scanner.inputBuffer.length = 0 THEN {scanner.tokenKind ← eof; RETURN};
scanner.tokenKind ← KindOf[scanner.inputBuffer[scanner.tokenStart]];
IF scanner.tokenKind = special
THEN {
scanner.tokenLength ← 1;
RETURN;
};
WHILE scanner.tokenStart+scanner.tokenLength<scanner.inputBuffer.length
AND KindOf[scanner.inputBuffer[scanner.tokenStart+scanner.tokenLength]] = scanner.tokenKind
DO
IF scanner.locationOfBufferStart+scanner.tokenStart+scanner.tokenLength = breakLoc THEN breakCount ← breakCount + 1;
scanner.tokenLength ← scanner.tokenLength + 1;
IF scanner.tokenStart + scanner.tokenLength = scanner.inputBuffer.length
THEN {
IF IO.EndOf[scanner.stream] THEN RETURN;
RefillBuffer[scanner];
};
ENDLOOP;
};
RefillBuffer:
PROC [scanner: Scanner] = {
FOR i:
NAT
IN [0..scanner.tokenLength)
DO
scanner.inputBuffer[i] ← scanner.inputBuffer[i+scanner.tokenStart];
ENDLOOP;
scanner.inputBuffer.length ← scanner.tokenLength;
scanner.locationOfBufferStart ← scanner.locationOfBufferStart+scanner.tokenStart;
scanner.tokenStart ← 0;
[] ← scanner.stream.GetBlock[block: scanner.inputBuffer, startIndex: scanner.tokenLength, count: scanner.inputBuffer.maxLength-scanner.tokenLength];
};
Match:
PROC [scanner: Scanner, key:
REF
READONLY
TEXT]
RETURNS [equal:
BOOLEAN] = {
i: NAT ← scanner.tokenStart;
IF key.length # scanner.tokenLength THEN RETURN [FALSE];
FOR j:
NAT
IN [0..key.length)
DO
IF key[j]#scanner.inputBuffer[i] THEN RETURN [FALSE];
i←i+1;
ENDLOOP;
RETURN [TRUE]
};
MetaError:
ERROR [sourceLoc:
INT] =
CODE;
Run:
PROC [fileNameStem:
ROPE, outputNameStem:
ROPE, binding:
LIST
OF RopePair] = {
in: IO.STREAM ← FS.StreamOpen[fileNameStem.Concat[".meta"]];
out: IO.STREAM ← FS.StreamOpen[outputNameStem.Concat[".MESA"], $create];
scanner: Scanner ← CreateScanner[in];
meta: BOOLEAN ← FALSE;
lineStart: BOOLEAN ← TRUE;
copiedTextStart: INT ← -1;
copiedTextLength: INT ← 0;
WriteBindings:
PROC [bindings:
LIST
OF RopePair] ~ {
IF bindings #
NIL
THEN {
WriteBindings[bindings.rest];
out.PutF["\t%g: INT ~ %g;\n", IO.rope[bindings.first.name], IO.rope[bindings.first.value]];
};
};
Flush:
PROC ~ {
IF copiedTextLength > 0
THEN {
IO.PutF[out, "Ptxt[%g, %g];\n", IO.int[copiedTextStart], IO.int[copiedTextLength]];
};
copiedTextStart ← -1;
copiedTextLength ← 0;
};
CopyOut:
PROC ~ {
IF meta THEN ERROR;
IF copiedTextStart+copiedTextLength = scanner.locationOfBufferStart+scanner.tokenStart THEN copiedTextLength ← copiedTextLength + scanner.tokenLength
ELSE
IF scanner.tokenLength > 0
THEN {
Flush[];
copiedTextStart ← scanner.locationOfBufferStart+scanner.tokenStart;
copiedTextLength ← scanner.tokenLength;
};
lineStart ← FALSE;
};
CopyMetaOut:
PROC ~ {
IF scanner.tokenLength > 0
THEN {
Flush[];
IO.PutBlock[out, scanner.inputBuffer, scanner.tokenStart, scanner.tokenLength];
};
lineStart ← FALSE;
};
StartPlain:
PROC = {
meta ← FALSE;
};
startMetaCount: INT ← 0;
StartMeta:
PROC [eof:
BOOLEAN ←
FALSE] = {
Flush[];
meta ← TRUE;
};
MetaText:
PROC [rope:
ROPE] = {
IF meta THEN ERROR;
Flush[];
IO.PutRope[out, rope];
};
inxx: BOOLEAN ← FALSE;
nestCount: NAT ← 0;
beginStackTop: NAT ← 0;
beginStack: ARRAY [0..50) OF NAT;
GetToken[scanner];
IO.PutF[out, boilerPlateBegin, IO.rope[outputNameStem], IO.rope[outputNameStem], IO.rope[fileNameStem]];
WriteBindings[binding];
StartPlain[];
WHILE scanner.tokenKind # eof
DO
IF meta
THEN {
SELECT scanner.tokenKind
FROM
special =>
SELECT scanner.inputBuffer[scanner.tokenStart]
FROM
' => StartPlain[];
' => MetaError[scanner.locationOfBufferStart+scanner.tokenStart];
ENDCASE => CopyMetaOut[];
ENDCASE => CopyMetaOut[];
}
ELSE {
SELECT scanner.tokenKind
FROM
special =>
SELECT scanner.inputBuffer[scanner.tokenStart]
FROM
' => StartMeta[];
' => MetaError[scanner.locationOfBufferStart+scanner.tokenStart];
'(, '{, '[ => {nestCount ← nestCount + 1; CopyOut[]};
'), '}, '] => {nestCount ← nestCount - 1; CopyOut[]};
'& => {
Flush[];
GetToken[scanner];
IO.PutRope[out, "PutInt["];
CopyMetaOut[];
IO.PutRope[out, "]; "];
};
ENDCASE => CopyOut[];
newline => {CopyOut[]; lineStart ← TRUE};
whitespace => IF lineStart THEN NULL ELSE CopyOut[];
identifier => {
CopyOut[];
SELECT
TRUE
FROM
Match[scanner, "DO"],
Match[scanner, "FROM"],
Match[scanner, "BEGIN"] => {
MetaText["Begin[];"];
beginStack[beginStackTop] ← nestCount;
beginStackTop ← beginStackTop + 1;
};
Match[scanner, "ENDLOOP"],
Match[scanner, "ENDCASE"],
Match[scanner, "END"] => {
MetaText["End[];"];
beginStackTop ← beginStackTop - 1;
IF beginStack[beginStackTop] # nestCount
THEN MetaError[scanner.locationOfBufferStart+scanner.tokenStart];
Something funny about the way things match up.
};
ENDCASE => NULL;
};
ENDCASE => CopyOut[];
};
GetToken[scanner];
ENDLOOP;
IF meta THEN StartPlain[];
StartMeta[eof: TRUE];
IO.PutRope[out, boilerPlateEnd];
IO.Close[in];
IO.Close[out];
};
boilerPlateBegin: ROPE = "
DIRECTORY Ascii, Rope, RopeFile, IO, FS;
MetaProgram: CEDAR PROGRAM IMPORTS Rope, RopeFile, IO, FS = {
ROPE: TYPE ~ Rope.ROPE;
TwoToThe: PROC [a: INT] RETURNS [b: INT] ~ {
IF a<0 THEN RETURN [0];
b ← 1;
THROUGH [0..a) DO b ← b+b ENDLOOP;
};
ModuleName: PROC ~ {IO.PutRope[stream, \"%g\"]};
stream: IO.STREAM ~ FS.StreamOpen[\"%g.mesa\", $create];
nest: NAT ← 0;
Begin: PROC ~ {nest ← nest + 1};
End: PROC ~ {nest ← nest - 1};
PutInt: PROC [i: INT] ~ {IO.PutF[stream, IF i < 0 THEN \"(%%g)\" ELSE \"%%g\", IO.int[i]]};
metaSource: ROPE ~ RopeFile.Create[name: \"%g.meta\", raw: FALSE];
Ptxt: PROC [start, length: CARDINAL] ~ {
s: INT ← start;
FOR i: INT IN [start..start+length) DO
SELECT metaSource.Fetch[i] FROM
'{, '[, '( => Begin[];
'}, '], ') => End[];
Ascii.CR => {
stream.PutRope[metaSource.Substr[s, i-s+1]];
FOR i: NAT IN [0..nest) DO stream.PutChar[Ascii.TAB] ENDLOOP;
s ← i+1;
};
ENDCASE => NULL;
ENDLOOP;
stream.PutRope[metaSource.Substr[s, start+length-s]];
};
";
boilerPlateEnd: ROPE = "IO.Close[stream]}.";
GetCmdToken:
PROC [stream:
IO.
STREAM]
RETURNS [rope:
ROPE ←
NIL] ~ {
rope ← IO.GetTokenRope[stream ! IO.EndOfStream => CONTINUE].token;
};
MetaCedarRunCommand: Commander.CommandProc ~ {
c: IO.STREAM ← IO.RIS[cmd.commandLine];
stem: ROPE ← GetCmdToken[c];
outputStem: ROPE ← GetCmdToken[c];
binding: LIST OF RopePair ← NIL;
IF outputStem = NIL THEN outputStem ← stem;
cmd.out.PutF["Creating %g.mesa from %g.meta:\n", IO.rope[outputStem], IO.rope[stem]];
UNTIL c.EndOf
DO
ropePair: RopePair ← [name: GetCmdToken[c], value: GetCmdToken[c]];
IF ropePair.name = NIL OR ropePair.value = NIL THEN EXIT;
cmd.out.PutF[" %g: INT ~ %g;\n", IO.rope[ropePair.name], IO.rope[ropePair.value]];
binding ← CONS[ropePair, binding];
ENDLOOP;
result ← CommandTool.DoCommand[Rope.Cat["Copy MetaCedarTemp.meta ← ", stem, ".meta"], cmd];
IF result = $Failure THEN RETURN;
result ← CommandTool.DoCommand["WriteMesaPlain MetaCedarTemp.meta", cmd];
IF result = $Failure THEN RETURN;
cmd.out.PutRope["Writing "]; cmd.out.PutRope[outputStem]; cmd.out.PutRope[".MESA . . . " ];
Run["MetaCedarTemp", outputStem, binding !
MetaError => {
result ← $Failure;
msg ← IO.PutFR["Something fishy at position &g of MetaCedarTemp.meta\n", IO.int[sourceLoc]]
}
];
IF result = $Failure THEN RETURN;
cmd.out.PutRope["Done.\n"];
result ← CommandTool.DoCommand[Rope.Cat["Compile ", outputStem, ".MESA"], cmd];
IF result = $Failure THEN RETURN;
result ← CommandTool.DoCommand[Rope.Cat["Run ", outputStem, ".bcd"], cmd];
IF result = $Failure THEN RETURN;
result ← CommandTool.DoCommand[Rope.Cat["Compile ", outputStem, ".mesa"], cmd];
};
Commander.Register["MetaCedar", MetaCedarRunCommand, "Simpleton macro expander"];