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;
};