DIRECTORY Ascii, Commander, CommandTool, Rope, IO, FS;

MetaCedarImpl: CEDAR PROGRAM IMPORTS Commander, CommandTool, Rope, IO, FS
= 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];
breakCount: INT _ 0;

GetToken: PROC [scanner: Scanner] ~ {
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];
};
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"];

END.

MetaCedarImpl.mesa
Copyright (C) 1984, 1985, Xerox Corporation.  All rights reserved.
Michael Plass, September 27, 1985 5:17:13 pm PDT
Gets the next token into inputBuffer[tokenStart] .. inputBuffer[tokenLength-1]
Something funny about the way things match up.
Κ
–˜š
œ™J™BJ™0J˜—JšΟk	œ&œœ
˜6J˜JšΠln
œœ
œ
œœ˜Išœ˜Jšœœœ
˜Jšœ
œœœ˜,Jšœ	œœ˜šœœœ˜Jšœœ
œ
˜Jš
œ˜Jšœ
œ
œ
˜Jšœœ
˜Jšœœ
œ
˜Jšœœ
˜Jšœ
˜Jš
œ˜J˜—Jšœœ˜Jšœœ˜!š
Οn
œœ
œ
œœ˜Fšœ
œ˜Jš
œ˜Jš
œ˜Jšœ
œ
œ˜(Jšœœ˜+Jšœœ
œ˜4Jš
œ˜Jš
œ˜Jš
œ˜—Jš
œ˜J˜—Jšœœ3˜=šŸœœœœ˜)šœ˜
Jšœœœœ˜AJš	œœœœœ˜5Jšœœœ˜Jšœœ˜—Jš
œ˜J˜—Jšœ
œœ
œ˜šœœ˜J˜—šŸœœ˜%Jš
œN™NJš
œ<˜<Jš
œ˜Jšœ0œ˜MJšœ œœ˜IJš
œD˜Dšœœ˜%Jš
œ˜Jšœ
˜Jš
œ˜—JšœB˜GšœY˜^JšœQœ˜tJš
œ.˜.šœGœ˜OJšœ
œœ
œ
˜(Jš
œ˜Jš
œ˜—Jšœ
˜—Jš
œ˜J˜—šŸœœ˜)šœœ
œ˜)Jš
œC˜CJšœ
˜—Jš
œ1˜1Jš
œQ˜QJš
œ˜Jš
œ”
˜”
J˜J˜—šŸœœœ
œ
œœ	œ˜SJšœœ˜Jšœ"œ
œœ˜8šœœ
œ˜ Jšœœ
œœ˜5J˜Jšœ
˜—Jšœœ
˜
J˜J˜—šœœ
œœ
˜)J˜—šŸœœœœœ
œ˜SJšœœ
œœ*˜<Jšœœ
œœ5˜HJš
œ%˜%Jšœœœ
˜Jšœœœ
˜Jšœœ˜Jšœœ˜šŸ
œœœ
œ˜4šœœ
œ˜Jš
œ˜Jšœœœ˜[Jš
œ˜—Jš
œ˜—šŸœœ˜šœœ˜Jšœœœ˜SJš
œ˜—Jš
œ˜Jš
œ˜Jš
œ˜—šŸœœ˜Jšœœ
œ
˜JšœUœ:˜•
šœ
œœ˜&Jš
œ˜Jš
œC˜CJš
œ'˜'Jš
œ˜—Jšœœ
˜Jš
œ˜—
codešŸœœ˜šœœ˜!Jš
œ˜KšœM˜OJš
œ˜—Jšœœ
˜Jš
œ˜—šŸ
œœ˜Jšœœ
˜
Jš
œ˜—Jšœœ˜šŸ	œœœœ˜*J˜Jšœœ
˜Jš
œ˜—šŸœœœ˜Jšœœ
œ
˜J˜Jšœ˜Jš
œ˜—Jšœœœ
˜Jšœœ˜Jšœœ˜Jšœœ	œ
œ
˜!Jš
œ˜Jšœœœœ˜hJš
œ˜Jš
œ
˜
šœ˜ šœœ˜šœ˜šœœ)˜>Jš
œ˜Jš
œB˜BJšœ˜—Jšœ˜—Jš
œ
˜
—šœ˜šœ˜šœœ)˜>Jš
œ˜Jš
œB˜BJš
œ5˜5Jš
œ5˜5š
œ˜J˜Jš
œ˜JšœΠbfœ˜Jš
œ˜Jšœ œ˜Jš
œ˜—Jšœ˜—Jšœ#œ˜)Jš	œœœ
œ
œ˜4š
œ˜Jš
œ
˜
šœ
œ
˜Jš
œ˜Jš
œ˜š
œ˜Jš
œ˜Jš
œ&˜&Jš
œ"˜"J˜—Jš
œ˜Jš
œ˜š
œ˜Jš
œ˜Jš
œ"˜"šœ'œ=˜jJ™.—J˜—Jšœœ
˜—Jš
œ˜—Jšœ˜—Jš
œ˜—Jš
œ˜Jšœ
˜—Jšœœ˜Jšœœ˜Jšœ˜ Jšœ˜
Jšœ˜J˜J˜—Jšœœ™˜―Jšœœ˜-šŸœœ
œ
œœœœ˜DJšœœœœ˜BJš
œ˜J˜—š
œ.˜.Jš	œœ
œœ
œ˜'Jšœœ˜Jšœœ˜"Jšœ	œ
œœ
˜ Jšœœ
œ˜+Jšœ1œœ
˜Ušœ	˜Jš
œC˜CJšœœ
œœ
œ
œ
˜9Jšœ"œœ˜SJšœ
œ˜"Jšœ
˜—Jš
œ[˜[Jšœœ
œ
˜!Jš
œI˜IJšœœ
œ
˜!Jš
œ[˜[š
œ*˜*š
œ˜Jš
œ˜Jš
œ[˜[Jš
œ
˜
—Jš
œ˜—Jšœœ
œ
˜!Jš
œ˜Jš
œO˜OJšœœ
œ
˜!Jš
œJ˜JJšœœ
œ
˜!Jš
œO˜OJš
œ˜J˜—˜QJ˜——Jšœ
˜—…—"΄.V