DIRECTORY Commander, CommanderOps, Convert, SymTab, Atom, FS, IO, CrankTypes, MPTree, MPLeaves, Rope, CrankOps, CrankAnalyze;

CrankMakePrinterImpl: CEDAR PROGRAM
IMPORTS Commander, CommanderOps, Convert, SymTab, Atom, FS, IO, Rope, CrankOps, CrankAnalyze
~ BEGIN OPEN CrankTypes, CrankOps;

Break: SIGNAL ~ CODE;

CrankPrinterCommand: Commander.CommandProc ~ {
fileName: ROPE ~ CommanderOps.NextArgument[cmd];
IF fileName = NIL THEN CommanderOps.Failed[cmd.procData.doc];
CrankAnalyze.Convert[fileName: fileName, analyze: TRUE, action: FromTree];
};

FromTree: PROC [tree: Tree, context: Context] ~ {
dir: SymTab.Ref ¬ SymTab.Create[];
InsertDir: PROC [rope: ROPE] ~ { [] ¬ SymTab.Insert[dir, rope, rope] };
stream: IO.STREAM ¬ IO.ROS[];
delayed: IO.STREAM ¬ IO.ROS[];
moduleID: ROPE ¬ NIL;
GenPrint: PROC [rope: ROPE] ~ {
IO.PutF1[stream, "  IO.PutRope[stream, %g];\n", [rope[Convert.RopeFromRope[rope]]]];
};
NameOfType: PROC [typeCode: TypeCode] RETURNS [ROPE] ~ {
typeNameList: LIST OF REF ~ GetTypeName[context, typeCode, FALSE];
qual: ROPE ~ NARROW[typeNameList.first];
base: ROPE ~ NARROW[typeNameList.rest.first];
IF Rope.Equal[qual, "BUILTIN", TRUE] THEN RETURN [base];
IF Rope.Equal[qual, "THRUTHEDESERT", TRUE] THEN RETURN [NIL];
InsertDir[qual];
RETURN [Rope.Cat[qual, ".", base]]
};
PrintableType: PROC [typeCode: TypeCode] RETURNS [ROPE] ~ {
typeNameList: LIST OF REF ~ GetTypeName[context, typeCode, FALSE];
qual: ROPE ~ NARROW[typeNameList.first];
base: ROPE ~ NARROW[typeNameList.rest.first];
IF Rope.Equal[qual, "BUILTIN", TRUE] THEN RETURN [base];
IF Rope.Equal[qual, "THRUTHEDESERT", TRUE] THEN {
WITH UnderType[context.types, typeCode] SELECT FROM
subrange: REF TypeRep.subrange => {
groundName: ROPE ~ NameOfType[subrange.groundType];
first: DINT ~ IntFromRef[subrange.first, INT.FIRST];
last: DINT ~ IntFromRef[subrange.last, CARD.LAST];
IntFromRef: PROC [ref: REF, default: DINT] RETURNS [DINT] ~ {
WITH ref SELECT FROM
ref: REF INT => RETURN [ref­];
ref: REF DINT => RETURN [ref­];
ref: REF CARD => RETURN [ref­];
ref: REF DCARD => RETURN [ref­];
ENDCASE => RETURN [default];
};
IF groundName = NIL OR first NOT IN [0..80] OR last NOT IN [0..255] THEN RETURN [NIL];
RETURN [IO.PutFR["%g[VAL[%g]..VAL[%g]]", [rope[groundName]], [integer[first]], [integer[last]]]]
};
ENDCASE => RETURN [NIL];
};
InsertDir[qual];
RETURN [Rope.Cat[qual, ".", base]]
};
BuiltInType: PROC [typeCode: TypeCode] RETURNS [BOOL] ~ {
typeNameList: LIST OF REF ~ GetTypeName[context, typeCode, FALSE];
qual: ROPE ~ NARROW[typeNameList.first];
RETURN [Rope.Equal[qual, "BUILTIN", TRUE]];
};
GenValuePrinter: PROC [name: ROPE, typeCode: TypeCode] ~ {
WITH UnderType[context.types, typeCode] SELECT FROM
reference: REF TypeRep.reference => {
IF reference.class = $REF
THEN {
IO.PutF1[stream, "  [] _ RefPrint.PrintREF[stream, %g];\n", [rope[name]]];
}
ELSE {
IO.PutF1[stream, "  IO.PutF1[stream, \"%%08xH\", [cardinal[LOOPHOLE[%g]]]];\n", [rope[name]]];
};
};
subrange: REF TypeRep.subrange => {
GenValuePrinter[name, subrange.groundType];
};
ENDCASE => {
typeNameList: LIST OF REF ~ GetTypeName[context, typeCode, FALSE];
qual: ROPE ~ NARROW[typeNameList.first];
base: ROPE ~ NARROW[typeNameList.rest.first];
typeName: ROPE ~ Rope.Cat[qual, ".", base];
IF Rope.Equal[qual, "BUILTIN", TRUE]
THEN {
f: ROPE ~ SELECT Atom.MakeAtom[NARROW[typeNameList.rest.first]] FROM
$BOOL, $BOOLEAN => "[boolean[%g]]",
$NAT, $BYTE, $INTEGER, $INT, $INT16, $INT32 => "[integer[%g]]",
$DINT => "IO.dint[%g]",
$CARD, $CARDINAL, $WORD, $CARD16, $CARD32 => "[cardinal[%g]]",
$DCARD => "IO.dcard[%g]",
$CHARACTER, $CHAR => "[character[%g]]",
$REAL, $DREAL => "[real[%g]]",
ENDCASE => NIL;
IF f = NIL THEN GenPrint["??"] ELSE {
IO.PutF1[stream, Rope.Cat["  IO.Put1[stream: stream, value: ", f, "];\n"], [rope[name]]];
};
}
ELSE {
IF Rope.Equal[qual, "THRUTHEDESERT", TRUE] THEN GenPrint["??"] ELSE {
InsertDir[qual];
IO.PutF[stream, "  [] _ RefPrint.PrintReferent[stream, NEW[%g _ %g]];\n", [rope[typeName]], [rope[name]]];
};
};
};
};
GenFieldListPrinter: PROC [varName: ROPE, fieldList: FieldList, typeName: ROPE] = {
GenPrint["["];
FOR tail: FieldList ¬ fieldList, tail.rest UNTIL tail = NIL DO
item: FieldListItem ~ tail.first;
itemSelector: ROPE = IF item.name = NIL THEN "­" ELSE Rope.Concat[".", item.name];
IF item.name # NIL THEN { GenPrint[item.name]; GenPrint[": "] };
WITH UnderType[context.types, item.rangeType] SELECT FROM
sequence: REF TypeRep.sequence => IF sequence.limitName # NIL THEN {
baseTypeName: ROPE ~ NameOfType[sequence.domainType];
IF baseTypeName = NIL THEN GenPrint["[...]"] ELSE {
IO.PutRope[stream, "  BEGIN\n"];
IO.PutRope[stream, "  first: BOOL _ TRUE;\n"];
GenPrint["("];
GenValuePrinter[Rope.Cat[varName, ".", sequence.limitName], sequence.domainType];
GenPrint[")"];
GenPrint["["];
IO.PutFL[stream, "  FOR i: %g IN [%g.FIRST..%g.%g) DO\n", LIST[[rope[baseTypeName]], [rope[baseTypeName]], [rope[varName]], [rope[sequence.limitName]]]];
IO.PutRope[stream, "    IF first THEN first _ FALSE ELSE IO.PutRope[stream, \", \"];\n  "];
GenValuePrinter[Rope.Concat[varName, "[i]"], sequence.rangeType];
IO.PutRope[stream, "    ENDLOOP;\n"];
IO.PutRope[stream, "  END;\n"];
GenPrint["]"];
};
};
array: REF TypeRep.array => {
domainName: ROPE ~ PrintableType[array.domainType];
IF domainName = NIL THEN GenPrint["[...]"] ELSE {
GenPrint["["];
IO.PutRope[stream, "  BEGIN\n"];
IO.PutRope[stream, "  first: BOOL _ TRUE;\n"];
IO.PutF[stream, "  FOR i: %g IN %g DO\n", [rope[domainName]], [rope[domainName]]];
IO.PutRope[stream, "    IF first THEN first _ FALSE ELSE IO.PutRope[stream, \", \"];\n  "];
GenValuePrinter[Rope.Cat[varName, itemSelector, "[i]"], array.rangeType];
IO.PutRope[stream, "    ENDLOOP;\n"];
IO.PutRope[stream, "  END;\n"];
GenPrint["]"];
};
};
union: REF TypeRep.union => {
IF union.tagName = NIL
THEN { GenPrint["[--overlaid--]"] }
ELSE  {
IO.PutF1[stream, "  WITH %g SELECT FROM\n", [rope[varName]]];
FOR tail: VariantList ¬ union.variantList, tail.rest UNTIL tail = NIL DO
tag: ROPE ~ NARROW[tail.first.value];
chooses: FieldList ~ tail.first.chooses;
IO.PutF[stream, "    x: REF %g.%g => {\n", [rope[typeName]], [rope[tag]]];
GenPrint[tag];
GenFieldListPrinter[varName: "x", fieldList: chooses, typeName: Rope.Cat[typeName, ".", tag]];
IO.PutRope[stream, "    };\n"];
ENDLOOP;
IO.PutRope[stream, "    ENDCASE => "];
GenPrint["??"];
};
};
enumerated: REF TypeRep.enumerated => {
IF BuiltInType[item.rangeType]
THEN {
GenValuePrinter[Rope.Concat[varName, itemSelector], item.rangeType];
}
ELSE {
IO.PutF[stream, "  SELECT %g%g FROM\n", [rope[varName]], [rope[itemSelector]]];
FOR tail: LIST OF EnumerationItem ¬ enumerated.items, tail.rest UNTIL tail = NIL DO
e: EnumerationItem ~ tail.first;
IF e.name # NIL THEN {
IO.PutF1[stream, "    %g => {", [rope[e.name]]];
GenPrint[e.name];
IO.PutRope[stream, "    };\n"];
};
ENDLOOP;
IO.PutF[stream, "    ENDCASE => IO.PutF1[stream, \"??%%g\", [cardinal[ORD[%g%g]]]];\n", [rope[varName]], [rope[itemSelector]]];
};
};
ENDCASE => {
GenValuePrinter[Rope.Concat[varName, itemSelector], item.rangeType];
};
IF tail.rest # NIL THEN GenPrint[", "];
ENDLOOP;
GenPrint["]"];
};
D: PROC [idNode, typeNode, valueNode: REF] = {
self: AttributedNode = NARROW[tree];
Each: PROC [item: Tree] = {
id: ROPE = GetIdentifier[item];
};
DoList[idNode, Each];
};
TypeDecl: PROC [identifierNode, typeNode, initialValueNode: REF] = {
Each: PROC [item: Tree] = {
id: ROPE = GetIdentifier[item];
procName: ROPE = Rope.Cat["REF", id, "Printer"];
referentTypeName: ROPE = Rope.Cat[moduleID, ".", id];
varName: ROPE = Rope.Concat["ref", id];
WITH UnderType[context.types, GetTypeValueAttribute[context.types, typeNode]] SELECT FROM
record: REF TypeRep.record => {};
array: REF TypeRep.array => {
IF PrintableType[array.domainType] = NIL THEN RETURN;
};
ENDCASE => RETURN;
IO.PutF1[stream, "%g: RefPrint.PrintRefProc = {\n", [rope[procName]]];
IO.PutF[stream, "  %g: REF %g = NARROW[ref];\n", [rope[varName]], [rope[referentTypeName]]];
WITH UnderType[context.types, GetTypeValueAttribute[context.types, typeNode]] SELECT FROM
record: REF TypeRep.record => { GenFieldListPrinter[varName, record.fieldList, referentTypeName] };
array: REF TypeRep.array => {
domainName: ROPE ~ PrintableType[array.domainType];
IF domainName = NIL THEN GenPrint["[...]"] ELSE {
GenPrint["["];
IO.PutRope[stream, "  BEGIN\n"];
IO.PutRope[stream, "  first: BOOL _ TRUE;\n"];
IO.PutF[stream, "  FOR i: %g IN %g DO\n", [rope[domainName]], [rope[domainName]]];
IO.PutRope[stream, "    IF first THEN first _ FALSE ELSE IO.PutRope[stream, \", \"];\n  "];
GenValuePrinter[Rope.Concat[varName, "[i]"], array.rangeType];
IO.PutRope[stream, "    ENDLOOP;\n"];
IO.PutRope[stream, "  END;\n"];
GenPrint["]"];
};
};
ENDCASE => IO.PutRope[stream, "  RETURN [FALSE];\n"];
IO.PutRope[stream, "  };\n"];
IO.PutF[delayed, "RefPrint.Register[%g, CODE[%g]];\n", [rope[procName]], [rope[referentTypeName]]];
};
DoList[identifierNode, Each];
};
Body: PROC [openNode, declarationsNode, bodyContentsNode, exitsNode: REF] = {
EachDecl: PROC [item: Tree] = {
[] ¬ With3[item, typedecl, TypeDecl];
};
DoList[declarationsNode, EachDecl];
};
TopLevelDecl: PROC [idNode, typeNode, valueNode: REF] = {
self: AttributedNode = NARROW[tree];
Each: PROC [item: Tree] = {moduleID ¬ GetIdentifier[item]};
DoList[idNode, Each];
IO.PutF1[stream, "%gPrintImpl: CEDAR PROGRAM IMPORTS IO, RefPrint = BEGIN\n", [rope[moduleID]]];
Assert[With4[valueNode, body, Body]];
IO.PutRope[stream, IO.RopeFromROS[delayed]];
IO.PutRope[stream, "END.\n"];
};
M: PROC [directory, imports, exports, shares, locks, decl: REF] = {
self: AttributedNode = NARROW[tree];
Assert[With3[decl, decl, TopLevelDecl]];
};
InsertDir["IO"];
InsertDir["RefPrint"];
Assert[With6[tree, module, M]];
IF moduleID = NIL THEN ERROR;
InsertDir[moduleID];
BEGIN
s: IO.STREAM = FS.StreamOpen[Rope.Concat[moduleID, "PrintImpl.mesa"], $create];
i: INT ¬ SymTab.GetSize[dir];
PairAction: SymTab.EachPairAction = {
IO.PutRope[s, key];
i ¬ i - 1;
IF i # 0 THEN IO.PutRope[s, ", "];
};
IO.PutRope[s, "DIRECTORY "];
[] ¬ SymTab.Pairs[x: dir, action: PairAction];
IO.PutRope[s, ";\n"];
IO.PutRope[s, IO.RopeFromROS[stream]];
IO.Close[s];
END;
};

Commander.Register["CrankPrinter", CrankPrinterCommand, "<fileName> - produce fooPrintImpl.mesa"];

END.
–
CrankMakePrinterImpl.mesa
Copyright Σ 1988, 1990, 1991 by Xerox Corporation.  All rights reserved.
Michael Plass, March 22, 1993 5:40 pm PST

Κu•NewlineDelimiter

–
(cedarcode) style™
code™Kšœ
Οe
œ=™HK™)K™—KšΟk	œ1žœžœ=˜}K˜KšΠlnœž
˜#Kšžœ1žœžœ˜\šœžœ
žœ˜"K˜šΟnœžœžœ
˜K˜—š œ˜.Kšœ
žœ"˜0Kšžœžœ
žœ'˜=Kšœ2žœ˜JK˜K˜—š œžœ#˜1K˜"Kš 	œžœžœ,˜GKš	œžœ
žœžœ
žœ˜Kš	œ	žœ
žœžœ
žœ˜Kšœ
žœžœ
˜š œžœžœ˜KšžœR˜TK˜—š 
œžœžœžœ˜8Kš	œžœ
žœ
žœ"žœ˜BKšœžœžœ˜(Kšœžœžœ˜-Kšžœžœžœ
žœ˜8Kš
žœ#žœžœ
žœžœ˜=K˜Kšžœ˜"K˜—š 
œžœžœžœ˜;Kš	œžœ
žœ
žœ"žœ˜BKšœžœžœ˜(Kšœžœžœ˜-Kšžœžœžœ
žœ˜8šžœ#žœžœ˜1šžœ$žœ
ž˜3šœ
žœ˜#Kšœžœ#˜3Kšœžœžœ
žœ˜4Kšœžœžœ
žœ˜2š 
œžœžœžœžœžœ˜=šžœžœ
ž˜Kšœžœ
žœžœ˜Kšœžœ
žœžœ˜Kšœžœ
žœžœ˜Kšœžœ
žœžœ˜ Kšžœžœ˜—Kš
œ˜—Kšžœžœ
žœžœ
žœ	žœžœ
žœ
žœ
žœžœ˜VKšžœžœV˜`K˜—Kšžœžœžœ˜—K˜—K˜Kšžœ˜"K˜—š œžœžœžœ˜9Kš	œžœ
žœ
žœ"žœ˜BKšœžœžœ˜(Kšžœžœ˜+K˜—š œžœžœ˜:šžœ$žœ
ž˜3šœžœ˜%šžœ˜šžœ˜KšžœH˜JK˜
—šžœ˜Kšžœ\˜^K˜——K˜—šœ
žœ˜#K˜+K˜—šžœ˜Kš	œžœ
žœ
žœ"žœ˜BKšœžœžœ˜(Kšœžœžœ˜-Kšœ
žœ˜+šžœžœ
˜$šžœ˜šœžœžœžœž˜DK˜#K˜?Kš
œ˜K˜>Kš
œ˜K˜'K˜Kšžœžœ
˜—šžœžœ
žœžœ˜%KšžœW˜YK˜—K˜
—šžœ˜Kšžœ#žœžœžœ˜E˜Kšžœh˜jK˜—K˜——K˜——K˜—š œžœžœ"žœ˜SK˜šžœ(žœžœ
ž˜>K˜!Kšœžœžœ
žœ
žœžœ˜RKšžœ
žœ
žœ)˜@šžœ*žœ
ž˜9š	œ
žœžœžœ
žœ˜DKšœžœ#˜5šžœžœ
žœžœ˜3Kšžœ˜ Kšžœ,˜.K˜K˜QK˜K˜Kšžœ8žœ[˜™
KšžœY˜[K˜AKšžœ#˜%Kšžœ˜K˜K˜—K˜—šœžœ˜Kšœžœ#˜3šžœžœ
žœžœ˜1K˜Kšžœ˜ Kšžœ,˜.KšžœP˜RKšžœY˜[K˜IKšžœ#˜%Kšžœ˜K˜K˜—K˜—šœžœ˜šžœž˜Kšžœ˜#šžœ˜Kšžœ;˜=šžœ2žœžœ
ž˜HKšœžœžœ˜%K˜(KšžœH˜JK˜K˜^Kšžœ˜Kšžœ
˜—Kšžœ$˜&K˜K˜——K˜—šœžœ˜'šžœ˜šžœ˜K˜DK˜
—šžœ˜KšžœM˜Ošžœžœ
žœ/žœžœ
ž˜SK˜ šžœ
žœ
žœ˜Kšžœ.˜0K˜Kšžœ˜K˜—Kšžœ
˜—Kšžœ}˜K˜——K˜—šžœ˜K˜DK˜——Kšžœ
žœ
žœ˜'Kšžœ
˜—K˜K˜—š 
œžœžœ˜.Kšœžœ˜$š œžœ˜Kšœžœ˜K˜—K˜K˜—š œžœ.žœ˜Dš œžœ˜Kšœžœ˜Kšœ
žœ"˜0Kšœžœ˜5Kšœ	žœ˜'šžœJžœ
ž˜YKšœžœ˜!šœžœ˜Kšžœ#žœ
žœ
žœ
˜5K˜—Kšžœžœ
˜—KšžœD˜FKšžœZ˜\šžœJžœ
ž˜YKšœžœX˜cšœžœ˜Kšœžœ#˜3šžœžœ
žœžœ˜1K˜Kšžœ˜ Kšžœ,˜.KšžœP˜RKšžœY˜[K˜>Kšžœ#˜%Kšžœ˜K˜K˜—K˜—Kšžœžœ(˜5—Kšžœ˜Kšžœa˜cK˜—K˜K˜—š œžœ;žœ˜Mš œžœ˜K˜%K˜—K˜#K˜—š œžœžœ˜9Kšœžœ˜$Kš œžœ1˜;K˜Kšžœ^˜`K˜%Kšžœžœ˜,Kšžœ˜K˜—š 
œžœ4žœ˜CKšœžœ˜$K˜(K˜—K˜K˜K˜Kšžœžœ
žœ
žœ
˜K˜š
ž˜Kšœžœ
žœžœ>˜OKšœžœ˜•StartOfExpansion= -- [key: ROPE, val: SymTab.Val] RETURNS [quit: BOOL _ FALSE]š 
œ˜%Kšžœ˜K˜
Kšžœžœ
žœ˜"K˜—Kšžœ˜K˜.Kšžœ˜Kšžœžœ˜&Kšžœ
˜Kšžœ
˜—K˜——˜˜bK˜——Kšžœ
˜—…—($4/