Heading:
PROC [h: Handle, out:
IO.
STREAM] ~ {
importTable: SymTab.Ref ~ h.allTheTables.workTable;
myInterface: ROPE;
myAuxInterface: ROPE;
ImportItem: SymTab.EachPairAction ~ {
name: ROPE ← NARROW [key];
entry: CType ← NARROW [val];
item: ROPE;
local: BOOLEAN;
[item, local] ← UnDoable[name, h.programKeyWD];
IF ( NOT local ) THEN RETURN;
SELECT entry.class
FROM
array => ImportRecursiveItem[entry.children.type];
bool => NULL;
card16 => NULL;
card32 => NULL;
choice => {
FOR child: CComponent ← entry.children, child.sibling
WHILE child #
NIL
DO
ImportRecursiveItem[child.type];
ENDLOOP;
};
enum => NULL;
error => NULL;
int16 => NULL;
int32 => NULL;
proc => NULL;
record => {
FOR child: CComponent ← entry.children, child.sibling
WHILE child #
NIL
DO
ImportRecursiveItem[child.type];
ENDLOOP;
};
seq => ImportRecursiveItem[entry.children.type];
sink => NULL;
source => NULL;
string => NULL;
unspec => NULL;
ENDCASE => ERROR;
};
ImportRecursiveItem:
PROC [typeName:
ROPE] ~ {
found: BOOL;
value: SymTab.Val;
entry: CType;
item: ROPE;
local: BOOL;
auxInterface: ROPE;
[found, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, typeName];
IF NOT found THEN ERROR;
entry ← NARROW [value];
[item, local] ← UnDoable[typeName, h.programKeyWD];
IF local THEN RETURN;
SELECT entry.class
FROM
array => NULL;
bool => RETURN;
card16 => RETURN;
card32 => RETURN;
choice => NULL;
enum => NULL;
error => RETURN;
int16 => RETURN;
int32 => RETURN;
proc => RETURN;
record => NULL;
seq => NULL;
sink => RETURN;
source => RETURN;
string => RETURN;
unspec => RETURN;
ENDCASE => ERROR;
[auxInterface~auxInterface] ← UnBundle[typeName];
[] ← SymTab.Insert[importTable, auxInterface, ""];
};
EmitDirectoryItem: SymTab.EachPairAction ~ {
auxInterface: ROPE ← NARROW [key];
IO.PutF[out, ",%g%g", IO.rope[Nest[NIL, 1]], IO.rope[auxInterface]];
};
EmitImportItem: SymTab.EachPairAction ~ {
auxInterface: ROPE ← NARROW [key];
IF
NOT Rope.Equal[auxInterface, myAuxInterface]
THEN
IO.PutF[out, ", %g", IO.rope[auxInterface]];
};
Heading main program
myInterface ← h.programKeyWD;
myAuxInterface ← Rope.Concat[myInterface, "Aux"];
SymTab.Erase[importTable];
[] ← SymTab.Insert[importTable, myAuxInterface, ""];
[] ← SymTab.Pairs[h.allTheTables.typeTable, ImportItem];
FileHeader[out, Rope.Concat[myAuxInterface, "Impl.Mesa"]];
IO.PutRope[out, Nest["DIRECTORY", 1]];
IO.PutRope[out, Nest["Convert,", 1]];
IO.PutRope[out, Nest["Rope,", 1]];
IO.PutF[out, "%g", IO.rope[myInterface]];
[] ← SymTab.Pairs[importTable, EmitDirectoryItem];
IO.PutRope[out, Nest[";", 0]];
IO.PutRope[out, Nest[NIL, 0]];
IO.PutF[out, Nest["%gImpl: CEDAR PROGRAM", 1], IO.rope[myAuxInterface]];
IO.PutRope[out, "IMPORTS Convert, Rope"];
[] ← SymTab.Pairs[importTable, EmitImportItem];
IO.PutRope[out, Nest[NIL, 1]];
IO.PutF[out, Nest["EXPORTS %g ~ {", 1], IO.rope[myAuxInterface]];
IO.PutF[out, Nest["OPEN %g, %g;", 1],
IO.rope[myInterface],
IO.rope[myAuxInterface]
];
IO.PutRope[out, Nest["", 1]];
IO.PutRope[out, Nest["ROPE: TYPE ~ Rope.ROPE;", 1]];
SymTab.Erase[importTable];
};
GenAuxImpl:
PUBLIC
PROC ~ {
aux: IO.STREAM;
failure: BOOLEAN;
h: Handle;
EmitHeader:
PROC [item:
ROPE] ~ {
IO.PutF[aux,
"%gExpose%g: PUBLIC PROC [arg: %g, level: NAT] RETURNS [res: ROPE] ~ {",
IO.rope[Nest[NIL,1]],
IO.rope[item],
IO.rope[item]
];
};
EmitSimpleProc:
PROC [item:
ROPE, body:
ROPE] ~ {
EmitHeader[item];
IO.PutF[aux, "%gres ← Rope.Cat[\"%g(\", %g, \")\"] };%g",
IO.rope[Nest[NIL,2]],
IO.rope[item],
IO.rope[body],
IO.rope[Nest[NIL,1]]
];
};
GenerateItem: SymTab.EachPairAction ~ {
name: ROPE ← NARROW [key];
entry: CType ← NARROW [val];
item: ROPE;
local: BOOLEAN;
[item, local] ← UnDoable[name, h.programKeyWD];
IF NOT local THEN RETURN;
SELECT entry.class
FROM
array => {
EmitHeader[item];
IO.PutF[aux, "%gres ← \"[\";", IO.rope[Nest[NIL, 2]]];
IO.PutF[aux, "%gFOR i: CARDINAL IN [0..%g) DO",
IO.rope[Nest[NIL, 2]],
IO.card[entry.bound]
];
IO.PutF[aux, "%gres ← Rope.Cat[res, IF i>0 THEN \", \" ELSE NIL, %g];",
IO.rope[Nest[NIL, 3]],
IO.rope[RecursiveItem["arg[i]", entry.children.type]]
];
IO.PutF[aux, "%gENDLOOP;%gres ← Rope.Concat[res, \"]\"];%g};%g",
IO.rope[Nest[NIL, 3]],
IO.rope[Nest[NIL, 2]],
IO.rope[Nest[NIL, 2]],
IO.rope[Nest[NIL, 1]]
];
};
bool => { EmitSimpleProc[item, "Convert.RopeFromBool[arg]"]; };
card16 => { EmitSimpleProc[item, "Convert.RopeFromCard[arg]"]; };
card32 => { EmitSimpleProc[item, "Convert.RopeFromCard[arg]"]; };
choice => {
objectName: ROPE ← MadeUpName[item, "Object"];
tag: CComponent ← entry.children;
EmitHeader[item];
IO.PutF[aux, "%gres ← Rope.Cat[\"%g(\", %g, \"): \"];",
IO.rope[Nest[NIL, 2]],
IO.rope[item],
IO.rope[RecursiveItem["arg.type", tag.type]]
];
IO.PutF[aux, "%gWITH arg SELECT FROM", IO.rope[Nest[NIL, 2]]];
FOR variant: CComponent ← entry.children.sibling, variant.sibling
WHILE variant #
NIL
DO
IO.PutF[aux, "%git: REF %g.%g => {",
IO.rope[Nest[NIL,3]],
IO.rope[objectName],
IO.rope[variant.name],
];
IO.PutF[aux, "%gres ← Rope.Concat[res, %g] };",
IO.rope[Nest[NIL, 4]],
IO.rope[RecursiveItem[Rope.Cat["it.", variant.name], variant.type]],
];
ENDLOOP;
IO.PutF[aux, "%gENDCASE => ERROR%g};%g",
IO.rope[Nest[NIL, 3]],
IO.rope[Nest[NIL, 2]],
IO.rope[Nest[NIL, 1]]];
};
enum => {
EmitHeader[item];
IO.PutF[aux, "%gSELECT arg FROM", IO.rope[Nest[NIL, 2]]];
FOR element: CComponent ← entry.children, element.sibling
WHILE element #
NIL
DO
IO.PutF[aux, "%g%g => res ← \"%g\";",
IO.rope[Nest[NIL,3]],
IO.rope[element.name],
IO.rope[element.name]
];
ENDLOOP;
IO.PutF[aux, "%gENDCASE => ERROR%g};%g",
IO.rope[Nest[NIL, 3]],
IO.rope[Nest[NIL, 2]],
IO.rope[Nest[NIL, 1]]];
};
error => { NULL; };
int16 => { EmitSimpleProc[item, "Convert.RopeFromInt[arg]"]; };
int32 => { EmitSimpleProc[item, "Convert.RopeFromInt[arg]"]; };
proc => { NULL; };
record => {
EmitHeader[item];
IF entry.children =
NIL
THEN {
IO.PutF[aux, "%gres ← \"[]\";", IO.rope[Nest[NIL, 2]] ];
}
ELSE {
IO.PutF[aux, "%gres ← \"[\";", IO.rope[Nest[NIL, 2]] ];
FOR child: CComponent ← entry.children, child.sibling
WHILE child #
NIL
DO
IO.PutF[aux, "%gres ← Rope.Cat[res, \"%g~\", %g, \"%g\"];",
IO.rope[Nest[NIL, 2]],
IO.rope[child.name],
IO.rope[RecursiveItem[Rope.Concat["arg.", child.name], child.type]],
IO.rope[IF child.sibling # NIL THEN ", " ELSE "]"]
];
ENDLOOP;
};
IO.PutF[aux, "%g};%g",
IO.rope[Nest[NIL, 2]],
IO.rope[Nest[NIL, 1]]
];
};
seq => {
EmitHeader[item];
IO.PutF[aux, "%gres ← \"[\";", IO.rope[Nest[NIL, 2]]];
IO.PutF[aux, "%gFOR i: CARDINAL IN [0..arg.length) DO",
IO.rope[Nest[NIL, 2]],
];
IO.PutF[aux, "%gres ← Rope.Cat[res, IF i>0 THEN \", \" ELSE NIL, %g];",
IO.rope[Nest[NIL, 3]],
IO.rope[RecursiveItem["arg.body[i]", entry.children.type]]
];
IO.PutF[aux, "%gENDLOOP;%gres ← Rope.Concat[res, \"]\"];%g};%g",
IO.rope[Nest[NIL, 3]],
IO.rope[Nest[NIL, 2]],
IO.rope[Nest[NIL, 2]],
IO.rope[Nest[NIL, 1]]
];
};
sink => { NULL; };
source => { NULL; };
string => { EmitSimpleProc[item, "arg"]; };
unspec => { EmitSimpleProc[item, "Convert.RopeFromCard[arg]"]; };
ENDCASE => ERROR;
};
RecursiveItem:
PROC [name:
ROPE, typeName:
ROPE]
RETURNS [x:
ROPE] ~ {
entry: CType;
found: BOOLEAN;
item: ROPE;
local: BOOLEAN;
value: SymTab.Val;
RecursiveItemByCall:
PROC ~ {
IF local
THEN {
x ←
IO.PutFR["Expose%g[%g, (level+1)]",
IO.rope[item],
IO.rope[name]
];
}
ELSE {
auxInterface, localTypeName: ROPE;
[auxInterface~auxInterface, type~localTypeName] ← UnBundle[typeName];
x ←
IO.PutFR["%g.Expose%g[%g, (level+1)]",
IO.rope[auxInterface],
IO.rope[localTypeName],
IO.rope[name]
];
};
};
[found, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, typeName];
IF ( NOT found ) THEN ERROR;
entry ← NARROW [value];
[item, local] ← UnDoable[typeName, h.programKeyWD];
SELECT entry.class
FROM
array => { RecursiveItemByCall[]; };
bool => { x ← IO.PutFR["Convert.RopeFromBool[%g]", IO.rope[name]]; };
card16 => { x ← IO.PutFR["Convert.RopeFromCard[%g]", IO.rope[name]]; };
card32 => { x ← IO.PutFR["Convert.RopeFromCard[%g]", IO.rope[name]]; };
choice => { RecursiveItemByCall[]; };
enum => { RecursiveItemByCall[]; };
error => { x ← "(error)"; };
int16 => { x ← IO.PutFR["Convert.RopeFromInt[%g]", IO.rope[name]]; };
int32 => { x ← IO.PutFR["Convert.RopeFromInt[%g]", IO.rope[name]]; };
proc => { x ← "(procedure)"; };
record => { RecursiveItemByCall[]; };
seq => { RecursiveItemByCall[]; };
sink => { x ← "(sink)"; };
source => { x ← "(source)"; };
string => { x ← name; };
unspec => { x ← IO.PutFR["Convert.RopeFromCard[%g]", IO.rope[name]]; };
ENDCASE => ERROR;
};
GenAuxImpl MAIN
h ← SIGNAL AquireState[];
aux ← FS.StreamOpen[Rope.Cat[h.programKeyWD, "AuxImpl.Mesa"], $create];
Heading[h, aux];
failure ← SymTab.Pairs[h.allTheTables.typeTable, GenerateItem];
IO.PutRope[aux, Nest[NIL, 0]];
IO.PutRope[aux, Nest["}...", 0]];
IO.Close[aux];
};