ThreeC4PrimImpl2.mesa: October 18, 1985 9:29:07 am PDT
Sturgis, May 10, 1986 3:11:54 pm PDT
Shoup, June 17, 1986 6:39:20 pm PDT
DIRECTORY
ThreeC4CProdAbGramDef USING[],
ThreeC4BaseDecl1Def USING[IdentifierNode, IntegerNode, NameListNode, NameNode, TypeListNode, TypeNode],
ThreeC4PrimImplDefs USING[GenNames, GenNameTypePairs, GenTypeList, GetIntegerData, GetNameCodeText, GetNameInfo, GetTypeCodeName, GlobalEnvHandle, GetGlobalEnv],
ThreeC4Support USING [GetSourceInfo, GetReportStream],
Convert USING[RopeFromInt],
FS USING[StreamOpen],
IO USING[Close, int, PutF, PutFR, PutRope, rope, RopeFromROS, ROS, STREAM],
Rope USING[Concat, Cat, ROPE];
ThreeC4PrimImpl2: CEDAR PROGRAM IMPORTS ThreeC4PrimImplDefs, Convert, FS, IO, Rope, ThreeC4Support EXPORTS ThreeC4CProdAbGramDef, ThreeC4BaseDecl1Def, ThreeC4PrimImplDefs =
BEGIN OPEN ThreeC4BaseDecl1Def, ThreeC4PrimImplDefs;
-- Mesa Code stuff
MesaCodeNode: TYPE = REF MesaCodeNodeBody;
MesaCodeNodeBody: PUBLIC TYPE = RECORD[
first: MesaCodeItem,
last: MesaCodeItem];
MesaCodeItem: TYPE = REF MesaCodeItemBody;
MesaCodeItemBody: TYPE = RECORD[
text: Rope.ROPE,
next: MesaCodeItem];
CodeFillerNode: TYPE = REF CodeFillerNodeBody;
CodeFillerNodeBody: PUBLIC TYPE = RECORD[text: Rope.ROPE];
BuildEmptyCode: PUBLIC PROC RETURNS[MesaCodeNode] =
{RETURN[NIL]};
RopeCode: PUBLIC PROC[rope: Rope.ROPE] RETURNS[MesaCodeNode] =
BEGIN
item: MesaCodeItem ← NEW[MesaCodeItemBody←[rope, NIL]];
RETURN[NEW[MesaCodeNodeBody←[item, item]]];
END;
RopeCode1: PUBLIC PROC[rope: Rope.ROPE, fill1: CodeFillerNode] RETURNS[MesaCodeNode] =
{RETURN[RopeCode[IO.PutFR[rope, IO.rope[fill1.text]]]]};
RopeCode2: PUBLIC PROC[rope: Rope.ROPE, fill1: CodeFillerNode, fill2: CodeFillerNode] RETURNS[MesaCodeNode] =
{RETURN[RopeCode[IO.PutFR[rope, IO.rope[fill1.text], IO.rope[fill2.text]]]]};
RopeCode3: PUBLIC PROC[rope: Rope.ROPE, fill1: CodeFillerNode, fill2: CodeFillerNode, fill3: CodeFillerNode] RETURNS[MesaCodeNode] =
{RETURN[RopeCode[IO.PutFR[rope, IO.rope[fill1.text], IO.rope[fill2.text], IO.rope[fill3.text]]]]};
RopeCode4: PUBLIC PROC[rope: Rope.ROPE, fill1: CodeFillerNode, fill2: CodeFillerNode, fill3: CodeFillerNode, fill4: CodeFillerNode] RETURNS[MesaCodeNode] =
{RETURN[RopeCode[IO.PutFR[rope, IO.rope[fill1.text], IO.rope[fill2.text], IO.rope[fill3.text], IO.rope[fill4.text]]]]};
BuildErrorCode: PUBLIC PROC[rope: Rope.ROPE] RETURNS[MesaCodeNode] =
BEGIN
pos, len: INT;
globalEnv: GlobalEnvHandle;
[pos, len] ← SIGNAL ThreeC4Support.GetSourceInfo;
IO.PutF[SIGNAL ThreeC4Support.GetReportStream, "[%g..%g] %g\N", IO.int[pos], IO.int[pos+len-1], IO.rope[rope]];
globalEnv← GetGlobalEnv[];
globalEnv.errorCount ← globalEnv.errorCount + 1;
RETURN [RopeCode["** ERROR **"]];
END;
IdFill: PUBLIC PROC[id: IdentifierNode] RETURNS[CodeFillerNode] =
{RETURN[NEW[CodeFillerNodeBody←[id.text]]]};
IdFill2: PUBLIC PROC[id1: IdentifierNode, id2: IdentifierNode] RETURNS[CodeFillerNode] =
{RETURN[NEW[CodeFillerNodeBody←[Rope.Concat[id1.text, id2.text]]]]};
CodeFill: PUBLIC PROC[code: MesaCodeNode] RETURNS[CodeFillerNode] =
BEGIN
rope: Rope.ROPE ← NIL;
IF code = NIL THEN RETURN[NEW[CodeFillerNodeBody←[""]]];
IF code.first = NIL THEN RETURN[NEW[CodeFillerNodeBody←[""]]];
IF code.first = code.last THEN RETURN[NEW[CodeFillerNodeBody←[code.first.text]]];
FOR item: MesaCodeItem ← code.first, item.next DO
rope ← Rope.Concat[rope, item.text];
IF item = code.last THEN EXIT;
ENDLOOP;
RETURN[NEW[CodeFillerNodeBody←[rope]]];
END;
IntegerFill: PUBLIC PROC[int: IntegerNode] RETURNS[CodeFillerNode] =
{RETURN[NEW[CodeFillerNodeBody←[Convert.RopeFromInt[GetIntegerData[int]]]]]};
IntFill: PUBLIC PROC[i: INT] RETURNS[CodeFillerNode] =
{RETURN[NEW[CodeFillerNodeBody←[Convert.RopeFromInt[i]]]]};
NameFill: PUBLIC PROC[name: NameNode] RETURNS[CodeFillerNode] =
{RETURN[NEW[CodeFillerNodeBody←[GetNameCodeText[name]]]]};
DotedNameFill: PUBLIC PROC[name: NameNode] RETURNS[CodeFillerNode] =
{RETURN[NEW[CodeFillerNodeBody←[GetNameInfo[name].text]]]};
damages all arguments
ConcatCode2: PUBLIC PROC[code1, code2: MesaCodeNode] RETURNS[MesaCodeNode] =
BEGIN
IF code1 = NIL OR code1.first = NIL THEN RETURN[code2];
IF code1.last = NIL THEN ERROR;
IF code2 = NIL OR code2.first = NIL THEN RETURN[code1];
IF code2.last = NIL THEN ERROR;
IF code1.last.next # NIL THEN ERROR;
IF code2.last.next # NIL THEN ERROR;
code1.last.next ← code2.first;
code1.last ← code2.last;
RETURN[code1];
END;
damages all arguments
ConcatCode3: PUBLIC PROC[code1, code2, code3: MesaCodeNode] RETURNS[MesaCodeNode] =
{RETURN[ConcatCode2[code1, ConcatCode2[code2, code3]]]};
damages all arguments
ConcatCode4: PUBLIC PROC[code1, code2, code3, code4: MesaCodeNode] RETURNS[MesaCodeNode] =
{RETURN[ConcatCode2[code1, ConcatCode2[code2, ConcatCode2[code3, code4]]]]};
damages all arguments
ConcatCode5: PUBLIC PROC[code1, code2, code3, code4, code5: MesaCodeNode] RETURNS[MesaCodeNode] =
{RETURN[ConcatCode2[code1, ConcatCode2[code2, ConcatCode2[code3, ConcatCode2[code4, code5]]]]]};
damages all arguments
ConcatCode6: PUBLIC PROC[code1, code2, code3, code4, code5, code6: MesaCodeNode] RETURNS[MesaCodeNode] =
{RETURN[ConcatCode2[code1, ConcatCode2[code2, ConcatCode2[code3, ConcatCode2[code4, ConcatCode2[code5, code6]]]]]]};
damages all arguments
ConcatCode7: PUBLIC PROC[code1, code2, code3, code4, code5, code6, code7: MesaCodeNode] RETURNS[MesaCodeNode] =
{RETURN[ConcatCode2[code1, ConcatCode2[code2, ConcatCode2[code3, ConcatCode2[code4, ConcatCode2[code5, ConcatCode2[code6, code7]]]]]]]};
damages all arguments
ConcatCode8: PUBLIC PROC[code1, code2, code3, code4, code5, code6, code7, code8: MesaCodeNode] RETURNS[MesaCodeNode] =
{RETURN[ConcatCode2[code1, ConcatCode2[code2, ConcatCode2[code3, ConcatCode2[code4, ConcatCode2[code5, ConcatCode2[code6, ConcatCode2[code7, code8]]]]]]]]};
damages all arguments
ConcatCode9: PUBLIC PROC[code1, code2, code3, code4, code5, code6, code7, code8, code9: MesaCodeNode] RETURNS[MesaCodeNode] =
{RETURN[ConcatCode2[code1, ConcatCode2[code2, ConcatCode2[code3, ConcatCode2[code4, ConcatCode2[code5, ConcatCode2[code6, ConcatCode2[code7, ConcatCode2[code8, code9]]]]]]]]]};
damages all arguments
ConcatCodePairs2: PUBLIC PROC[codeA1, codeA2, codeB1, codeB2: MesaCodeNode] RETURNS[MesaCodeNode, MesaCodeNode] =
{RETURN[ConcatCode2[codeA1, codeB1], ConcatCode2[codeA2, codeB2]]};
TestEmptyCode: PUBLIC PROC[code: MesaCodeNode] RETURNS[BOOLEAN] =
{RETURN[code = NIL OR code.first = NIL]};
This is treated as a copy, which is a cheat. Once the damage assesment routines have been improved to recognize that damage done in one branch of a conditional can not affect suspect arguments in the other branch of the conditional, then this procedure can be marked as damaging its argument. Then it will no longer be a cheat.
FakeCopyCodeForConditional: PUBLIC PROC[code: MesaCodeNode] RETURNS[MesaCodeNode] =
{RETURN[code]};
ShowCode: PUBLIC PROC[code: MesaCodeNode, on: IO.STREAM] =
BEGIN
IF code = NIL THEN RETURN;
FOR item: MesaCodeItem ← code.first, item.next WHILE item # NIL DO
IO.PutRope[on, item.text];
ENDLOOP;
END;
CodeToRope: PROC[code: MesaCodeNode] RETURNS[Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
r: Rope.ROPE;
ShowCode[code, s];
r ← IO.RopeFromROS[s];
IO.Close[s];
RETURN[r];
END;
RopeFromCode: PUBLIC PROC[code: MesaCodeNode] RETURNS[Rope.ROPE] =
BEGIN
text: Rope.ROPE ← NIL;
IF code = NIL THEN RETURN[NIL];
FOR item: MesaCodeItem ← code.first, item.next WHILE item # NIL DO
text ← Rope.Cat[text, item.text];
ENDLOOP;
RETURN[text];
END;
BuildNameSeqArgCode: PUBLIC PROC[names: NameListNode] RETURNS[code: MesaCodeNode] =
BEGIN
seeAName: PROC[name: NameNode] =
BEGIN
IF TestEmptyCode[code] THEN code ← RopeCode[GetNameCodeText[name]]
ELSE code ← ConcatCode3[code, RopeCode[", "], RopeCode[GetNameCodeText[name]]];
END;
code ← BuildEmptyCode[];
GenNames[names, seeAName];
END;
This really should be some sort of non tree recursive function
BuildResultTypeCode: PUBLIC PROC[typeList: TypeListNode] RETURNS[MesaCodeNode] =
BEGIN
code: MesaCodeNode ← BuildEmptyCode[];
seeOneType: PROC[type: TypeNode] =
BEGIN
IF TestEmptyCode[code] THEN code ← GetTypeCodeName[type]
ELSE code ← ConcatCode3[code, RopeCode[", "], GetTypeCodeName[type]];
END;
GenTypeList[typeList, seeOneType];
RETURN[code]
END;
this really should be some sort of non tree recursive function
BuildArgNameTypeCode: PUBLIC PROC[names: NameListNode, types: TypeListNode] RETURNS[MesaCodeNode] =
BEGIN
RETURN[BuildNameTypeCode[names, types, ", "]];
END;
BuildVarDeclCode: PUBLIC PROC[names: NameListNode, types: TypeListNode] RETURNS[MesaCodeNode] =
BEGIN
most: MesaCodeNode ← BuildNameTypeCode[names, types, ";\N"];
RETURN[IF TestEmptyCode[most] THEN most ELSE ConcatCode2[most, RopeCode[";\N"]]];
END;
BuildNameTypeCode: PUBLIC PROC[names: NameListNode, types: TypeListNode, fill: Rope.ROPE] RETURNS[MesaCodeNode] =
BEGIN
code: MesaCodeNode ← BuildEmptyCode[];
SeeOnePair: PROC[name: NameNode, type: TypeNode] =
BEGIN
IF NOT TestEmptyCode[code] THEN code ← ConcatCode2[code, RopeCode[fill]];
code ← ConcatCode3[code, RopeCode[GetNameCodeText[name]], RopeCode[": "]];
code ← ConcatCode2[code, GetTypeCodeName[type]];
END;
GenNameTypePairs[names, types, SeeOnePair];
RETURN[code];
END;
-- File Seq stuff
FileSeqNode: TYPE = REF FileSeqNodeBody;
FileSeqNodeBody: PUBLIC TYPE = RECORD[
first: FileNode,
last: FileNode];
FileNode: TYPE = REF FileNodeBody;
FileNodeBody: TYPE = RECORD[
fileName: MesaCodeNode,
code: MesaCodeNode,
next: FileNode];
BuildEmptyFileSeq: PUBLIC PROC RETURNS[FileSeqNode] =
{RETURN[NIL]};
BuildOneFileSeq: PUBLIC PROC[fileName: MesaCodeNode, code: MesaCodeNode] RETURNS[FileSeqNode] =
BEGIN
file: FileNode ← NEW[FileNodeBody←[fileName, code, NIL]];
RETURN[NEW[FileSeqNodeBody←[file, file]]];
END;
damages seq argument
AppendToFileSeq: PUBLIC PROC[seq: FileSeqNode, fileName: MesaCodeNode, code: MesaCodeNode] RETURNS[FileSeqNode] =
BEGIN
file: FileNode ← NEW[FileNodeBody←[fileName, code, NIL]];
IF seq = NIL THEN RETURN[NEW[FileSeqNodeBody←[file, file]]];
IF seq.first = NIL THEN seq.first ← file
ELSE seq.last.next ← file;
seq.last ← file;
RETURN[seq];
END;
damages both arguments
ConcatFileSeq: PUBLIC PROC[seq1: FileSeqNode, seq2: FileSeqNode] RETURNS[FileSeqNode] =
BEGIN
IF seq1 = NIL OR seq1.first = NIL THEN RETURN[seq2];
IF seq2 = NIL OR seq2.first = NIL THEN RETURN[seq1];
seq1.last.next ← seq2.first;
seq1.last ← seq2.last;
RETURN[seq1];
END;
This is treated as a copy, which is a cheat. Once the damage assesment routines have been improved to recognize that damage done in one branch of a conditional can not affect suspect arguments in the other branch of the conditional, then this procedure can be marked as damaging its argument. Then it will no longer be a cheat.
FakeCopyFileSeqForConditional: PUBLIC PROC[seq: FileSeqNode] RETURNS[FileSeqNode] =
{RETURN[seq]};
ShowFileSeq: PUBLIC PROC[seq: FileSeqNode, on: IO.STREAM] =
BEGIN
IF seq = NIL THEN RETURN;
FOR file: FileNode ← seq.first, file.next WHILE file # NIL DO
ShowFile[file, on];
IF file = seq.last THEN EXIT;
ENDLOOP;
END;
ShowFile: PROC[file: FileNode, on: IO.STREAM] =
BEGIN
IO.PutF[on, "contents of file with name "];
ShowCode[file.fileName, on];
IO.PutF[on, "\N\N"];
ShowCode[file.code, on];
IO.PutF[on, "\N\N"];
END;
WriteFiles: PUBLIC PROC[seq: FileSeqNode, targetFNPrefix: Rope.ROPE, reportStream: IO.STREAM] =
BEGIN
IF seq = NIL THEN RETURN;
FOR file: FileNode ← seq.first, file.next WHILE file # NIL DO
fileName: Rope.ROPE ← Rope.Concat[targetFNPrefix, RopeFromCode[file.fileName]];
stream: IO.STREAM ←
FS.StreamOpen[fileName, $create];
IO.PutF[reportStream, "%g\N", IO.rope[fileName]];
ShowCode[file.code, stream];
IO.Close[stream];
ENDLOOP;
END;
END..