=
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:
BOOL] = {
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 ¬ PFS.StreamOpen[PFS.PathFromRope[fileNameStem.Concat[".meta"]]];
out: IO.STREAM ¬ PFS.StreamOpen[PFS.PathFromRope["MetaProgram.mesa"], $create];
scanner: Scanner ¬ CreateScanner[in];
mode: {meta, quoteargs, text} ¬ text;
lineStart: BOOL ¬ 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", [rope[bindings.first.name]], [rope[bindings.first.value]]];
};
};
Flush:
PROC ~ {
IF copiedTextLength > 0
THEN {
IO.PutF[out, "Ptxt[%g, %g];\n", [integer[copiedTextStart]], [integer[copiedTextLength]]];
};
copiedTextStart ¬ -1;
copiedTextLength ¬ 0;
};
CopyOut:
PROC ~ {
IF mode#text 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;
};
arg: ROPE ¬ NIL;
unquoted: ROPE ¬ NIL;
CopyQuotedOut:
PROC ~ {
arg ¬ Rope.Concat[arg, Rope.FromRefText[s: scanner.inputBuffer, start: scanner.tokenStart, len: scanner.tokenLength]];
};
CopyUnquotedOut:
PROC [type:
ROPE] ~ {
id: ROPE ~ Rope.FromRefText[s: scanner.inputBuffer, start: scanner.tokenStart, len: scanner.tokenLength];
arg ¬ Rope.Concat[arg, "%g"];
IF unquoted # NIL THEN unquoted ¬ Rope.Concat[unquoted, ", "];
unquoted ¬ Rope.Concat[unquoted, IO.PutFR["[%g[%g]]", [rope[type]], [rope[id]]]];
};
QFlush:
PROC ~ {
Flush[];
IF unquoted # NIL THEN IO.PutRope[out, "IO.PutFLR["];
IF arg#NIL THEN IO.PutRope[out, Convert.RopeFromRope[arg]];
IF unquoted #
NIL
THEN {
IO.PutRope[out, ", LIST["];
IO.PutRope[out, unquoted];
IO.PutRope[out, "]]"];
};
unquoted ¬ arg ¬ NIL;
};
StartPlain:
PROC = {
mode ¬ text;
};
startMetaCount: INT ¬ 0;
StartMeta:
PROC [eof:
BOOL ¬
FALSE] = {
Flush[];
mode ¬ meta;
};
MetaText:
PROC [rope:
ROPE] = {
IF mode#text THEN ERROR;
Flush[];
IO.PutRope[out, rope];
};
inxx: BOOL ¬ FALSE;
nestCount: NAT ¬ 0;
qnest: INT ¬ 0;
beginStackTop: NAT ¬ 0;
beginStack: ARRAY [0..50) OF NAT;
GetToken[scanner];
IO.PutF[out, boilerPlateBegin, [rope[outputNameStem]], [rope[outputNameStem]], [rope[fileNameStem]]];
WriteBindings[binding];
StartPlain[];
WHILE scanner.tokenKind # eof
DO
SELECT mode
FROM
meta => {
SELECT scanner.tokenKind
FROM
special =>
SELECT scanner.inputBuffer[scanner.tokenStart]
FROM
' => StartPlain[];
' => MetaError[scanner.locationOfBufferStart+scanner.tokenStart];
ENDCASE => CopyMetaOut[];
ENDCASE => CopyMetaOut[];
};
quoteargs => {
SELECT scanner.tokenKind
FROM
special =>
SELECT scanner.inputBuffer[scanner.tokenStart]
FROM
', => {
IF qnest = 0
THEN {QFlush[]; IO.PutRope[out, ", "]}
ELSE CopyQuotedOut[]
};
'(, '{, '[ => {qnest ¬ qnest + 1; CopyQuotedOut[]};
'), '} => {
qnest ¬ qnest - 1;
IF qnest < 0
THEN MetaError[scanner.locationOfBufferStart+scanner.tokenStart]
ELSE CopyQuotedOut[]
};
'] => {
qnest ¬ qnest - 1;
IF qnest < 0
THEN {mode ¬ text; QFlush[]; IO.PutRope[out, "]; "]}
ELSE CopyQuotedOut[]
};
'& => {
GetToken[scanner];
CopyUnquotedOut["integer"];
};
'% => {
GetToken[scanner];
CopyUnquotedOut["rope"];
};
'?, ', ' => {
MetaError[scanner.locationOfBufferStart+scanner.tokenStart];
};
ENDCASE => CopyQuotedOut[];
ENDCASE => CopyQuotedOut[];
};
text => {
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, "]; "];
};
'% => {
Flush[];
GetToken[scanner];
IO.PutRope[out, "stream.PutRope["];
CopyMetaOut[];
IO.PutRope[out, "]; "];
};
'? => {
Flush[];
GetToken[scanner];
CopyMetaOut[];
GetToken[scanner];
IF scanner.inputBuffer[scanner.tokenStart] # '[ THEN MetaError[scanner.locationOfBufferStart+scanner.tokenStart];
IO.PutRope[out, "["];
qnest ¬ 0;
mode ¬ quoteargs;
};
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[];
};
ENDCASE => ERROR;
GetToken[scanner];
ENDLOOP;
IF mode=meta THEN StartPlain[];
StartMeta[eof: TRUE];
IO.PutRope[out, boilerPlateEnd];
IO.Close[in];
IO.Close[out];
};
boilerPlateBegin: ROPE = "
DIRECTORY Rope, IO, PFS;
MetaProgram: CEDAR PROGRAM IMPORTS Rope, IO, PFS = {
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 ~ PFS.StreamOpen[PFS.PathFromRope[\"%g.mesa\"], $create];
nest: NAT ← 0;
Begin: PROC ~ {nest ← nest + 1};
End: PROC ~ {nest ← nest - 1};
PutInt: PROC [i: INT] ~ {
IO.PutF1[stream, IF i < 0 THEN \"(%%g)\" ELSE \"%%g\", [integer[i]]]};
metaSource: ROPE ~ PFS.RopeOpen[PFS.PathFromRope[\"%g.meta\"]].rope;
Ptxt: PROC [start, length: CARDINAL] ~ {
s: INT ← start;
FOR i: INT IN [start..start+length) DO
SELECT metaSource.Fetch[i] FROM
'{, '[, '( => Begin[];
'}, '], ') => End[];
'\r => {
stream.PutRope[metaSource.Substr[s, i-s+1]];
FOR i: NAT IN [0..nest) DO stream.PutChar['\t] 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 ~ {
ENABLE PFS.Error => CommanderOps.Failed[error.explanation];
c: IO.STREAM ¬ IO.RIS[cmd.commandLine];
stem: ROPE ¬ GetCmdToken[c];
outputStem: ROPE ¬ GetCmdToken[c];
binding: LIST OF RopePair ¬ NIL;
out: IO.STREAM ¬ cmd.out;
tmpDir: ROPE ~ Rope.Cat["/tmp/meta-", stem, "/"];
IF outputStem = NIL THEN outputStem ¬ stem;
out.PutF["Creating %g.mesa from %g.meta:\n", [rope[outputStem]], [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", [rope[ropePair.name]], [rope[ropePair.value]]];
binding ¬ CONS[ropePair, binding];
ENDLOOP;
result ¬ CommanderOps.DoCommand[Rope.Concat["mkdir /tmp/meta-", stem], cmd];
result ¬ CommanderOps.DoCommand[
Rope.Cat["Copy ", tmpDir, "MetaCedarTemp.meta ← ", stem, ".meta"],
cmd];
IF result = $Failure THEN RETURN;
BEGIN
InTmp:
PROC ~ {
result ¬ CommanderOps.DoCommand["WriteMesaPlain MetaCedarTemp.meta", cmd];
IF result = $Failure THEN RETURN;
IO.PutRope[out, "Writing MetaProgram.mesa . . . "];
Run["MetaCedarTemp", outputStem, binding !
MetaError => {
result ¬ $Failure;
msg ¬ IO.PutFR1["Something fishy at position &g of MetaCedarTemp.meta\n", [integer[sourceLoc]]]
}
];
IF result = $Failure THEN RETURN;
out.PutRope["Done.\n"];
result ¬ CommanderOps.DoCommand["bringover -o BasicTime.mob Rope.mob IO.mob PFS.mob /Cedar/Top/PFS.df", cmd];
result ¬ CommanderOps.DoCommand["mkdir sun4", cmd];
result ¬ CommanderOps.DoCommand["Mako -~o MetaProgram.mesa", cmd];
IF result = $Failure THEN RETURN;
result ¬ CommanderOps.DoCommand["Run -a MetaProgram", cmd];
IF result = $Failure THEN RETURN;
result ¬ CommanderOps.DoCommand[Rope.Cat["TiogaMesa ", outputStem, ".mesa"], cmd];
};
PFS.DoInWDir[PFS.PathFromRope[tmpDir], InTmp];
END;
IF result = $Failure THEN RETURN;
result ¬ CommanderOps.DoCommand[Rope.Cat["Copy ", tmpDir, outputStem, ".mesa"], cmd];
IF result = $Failure THEN RETURN;
result ¬ CommanderOps.DoCommand[Rope.Cat["Mako ", outputStem, ".mesa"], cmd];
};
Commander.Register["MetaCedar", MetaCedarRunCommand, "Simpleton macro expander"];