GenerateAuxImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Bill Jackson (bj) September 25, 1986 3:15:31 am PDT
Demers, January 1, 1987 1:44:53 pm PST
DIRECTORY
BasicTime USING [],
FS USING [StreamOpen],
HashTable USING [EachPairAction, Erase, Fetch, Insert, Pairs, Value],
IO USING [STREAM, card, rope, Close, PutF, PutFR, PutRope],
Rope USING [ROPE, Cat, Concat, Equal, Find, Substr],
SiroccoPrivate USING [AquireState, CComponent, CType, FileHeader, Handle, MadeUpName, Nest, Table, TABLES, UnDoable];
GenerateAuxImpl: CEDAR PROGRAM
IMPORTS FS, HashTable, IO, Rope, SiroccoPrivate
EXPORTS SiroccoPrivate ~ {
OPEN SiroccoPrivate;
Copied Types
ROPE: TYPE ~ Rope.ROPE;
Value: TYPE ~ HashTable.Value;
Procs
UnBundle: PROC [kind: ROPE]
RETURNS [interface: ROPE ← NIL, auxInterface: ROPE ← NIL, type: ROPE] ~ {
dotPos: INT ~ Rope.Find[kind, "."];
IF dotPos >= 0 THEN {
interface ← Rope.Substr[base~kind, len~dotPos];
auxInterface ← Rope.Concat[interface, "Aux"];
};
type ← Rope.Substr[base~kind, start~dotPos+1];
};
Heading: PROC [h: Handle, out: IO.STREAM] ~ {
importTable: Table ~ h.allTheTables.workTable;
myInterface: ROPE;
myAuxInterface: ROPE;
ImportItem: HashTable.EachPairAction ~ {
name: ROPE ← NARROW [key];
entry: CType ← NARROW [value];
item: ROPE;
local: BOOLEAN;
[item, local] ← UnDoable[name, h.programKeyWD];
IF NOT local THEN RETURN;
SELECT entry.class FROM
array =>
ImportRecursiveItem[entry.children.type];
boolean => NULL;
bulkDataSink => NULL;
bulkDataSource => NULL;
cardinal => NULL;
choice => {
FOR child: CComponent ← entry.children, child.sibling
WHILE child # NIL DO
ImportRecursiveItem[child.type];
ENDLOOP;
};
enumeration => NULL;
error => NULL;
integer => NULL;
longCardinal => NULL;
longInteger => NULL;
procedure => NULL;
record => {
FOR child: CComponent ← entry.children, child.sibling
WHILE child # NIL DO
ImportRecursiveItem[child.type];
ENDLOOP;
};
sequence =>
ImportRecursiveItem[entry.children.type];
string => NULL;
unspecified => NULL;
ENDCASE => ERROR;
};
ImportRecursiveItem: PROC [typeName: ROPE] ~ {
found: BOOL;
value: Value;
entry: CType;
item: ROPE;
local: BOOL;
auxInterface: ROPE;
[found, value] ← HashTable.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;
boolean => RETURN;
bulkDataSink => RETURN;
bulkDataSource => RETURN;
cardinal => RETURN;
choice => NULL;
enumeration => NULL;
error => RETURN;
integer => RETURN;
longCardinal => RETURN;
longInteger => RETURN;
procedure => RETURN;
record => NULL;
sequence => NULL;
string => RETURN;
unspecified => RETURN;
ENDCASE => ERROR;
[auxInterface~auxInterface] ← UnBundle[typeName];
[] ← HashTable.Insert[importTable, auxInterface, ""];
};
EmitDirectoryItem: HashTable.EachPairAction ~ {
auxInterface: ROPE ← NARROW [key];
IO.PutF[out, ",%g%g", IO.rope[Nest[NIL, 1]], IO.rope[auxInterface]];
};
EmitImportItem: HashTable.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"];
HashTable.Erase[importTable];
[] ← HashTable.Insert[importTable, myAuxInterface, ""];
[] ← HashTable.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]];
[] ← HashTable.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"];
[] ← HashTable.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]];
HashTable.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: HashTable.EachPairAction ~ {
name: ROPE ← NARROW [key];
entry: CType ← NARROW [value];
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]]
];
};
boolean => {
EmitSimpleProc[item, "Convert.RopeFromBool[arg]"];
};
bulkDataSink => {
NULL;
};
bulkDataSource => {
NULL;
};
cardinal => {
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]]];
};
enumeration => {
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;
};
integer => {
EmitSimpleProc[item, "Convert.RopeFromInt[arg]"];
};
longCardinal => {
EmitSimpleProc[item, "Convert.RopeFromCard[arg]"];
};
longInteger => {
EmitSimpleProc[item, "Convert.RopeFromInt[arg]"];
};
procedure => {
NULL;
};
record => {
IF entry.children = NIL THEN {
Handle Empty Record as a special case because of compiler bug
IO.PutF[aux, "%gExpose%g: PUBLIC PROC [--arg: %g,-- level: NAT] RETURNS [res: ROPE] ~ { res ← \"[]\" };%g",
IO.rope[Nest[NIL, 1]],
IO.rope[item],
IO.rope[item],
IO.rope[Nest[NIL, 1]],
];
RETURN;
};
EmitHeader[item];
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]]
];
};
sequence => {
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]]
];
};
string => {
EmitSimpleProc[item, "arg"];
};
unspecified => {
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: Value;
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] ← HashTable.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[];
};
boolean => {
x ← IO.PutFR["Convert.RopeFromBool[%g]", IO.rope[name]];
};
bulkDataSink => {
x ← "(sink)";
};
bulkDataSource => {
x ← "(source)";
};
cardinal => {
x ← IO.PutFR["Convert.RopeFromCard[%g]", IO.rope[name]];
};
choice => {
RecursiveItemByCall[];
};
enumeration => {
RecursiveItemByCall[];
};
error => {
x ← "(error)";
};
integer => {
x ← IO.PutFR["Convert.RopeFromInt[%g]", IO.rope[name]];
};
longCardinal => {
x ← IO.PutFR["Convert.RopeFromCard[%g]", IO.rope[name]];
};
longInteger => {
x ← IO.PutFR["Convert.RopeFromInt[%g]", IO.rope[name]];
};
procedure => {
x ← "(procedure)";
};
record => {
IF entry.children = NIL THEN {
Handle Empty Record as a special case because of compiler bug
auxInterface, localTypeName: ROPE;
[auxInterface~auxInterface, type~localTypeName] ← UnBundle[typeName];
IF local
THEN x ← IO.PutFR["Expose%g[--%g,-- (level+1)]",
IO.rope[item],
IO.rope[name]
]
ELSE x ← IO.PutFR["%g.Expose%g[--%g,-- (level+1)]",
IO.rope[auxInterface],
IO.rope[localTypeName],
IO.rope[name]
];
RETURN;
};
RecursiveItemByCall[];
};
sequence => {
RecursiveItemByCall[];
};
string => {
x ← name;
};
unspecified => {
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 ← HashTable.Pairs[h.allTheTables.typeTable, GenerateItem];
IO.PutRope[aux, Nest[NIL, 0]];
IO.PutRope[aux, Nest["}...", 0]];
IO.Close[aux];
};
}.