GenerateAuxImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Bill Jackson (bj) September 25, 1986 3:15:31 am PDT
DIRECTORY
BasicTime USING [],
FS USING [StreamOpen],
HashTable USING [EachPairAction, Fetch, Pairs, Value],
IO USING [STREAM, card, int, rope, Close, PutF, PutFR],
Rope USING [ROPE, Cat],
SiroccoPrivate USING [AquireState, CComponent, CType, FileHeader, Handle, Nest, 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
Heading: PROC [out: IO.STREAM, programKeyWD: ROPE] ~ {
SiroccoPrivate.FileHeader[out, Rope.Cat[programKeyWD, "AuxImpl.Mesa"]];
IO.PutF[out, Nest["DIRECTORY", 1]];
IO.PutF[out, Nest["Convert,", 1]];
IO.PutF[out, Nest["Rope,", 1]];
IO.PutF[out, Nest["%g,", 1], IO.rope[programKeyWD]];
IO.PutF[out, Nest["%gAux;", 0], IO.rope[programKeyWD]];
IO.PutF[out, Nest["", 0]];
IO.PutF[out, Nest["%gAuxImpl: CEDAR PROGRAM", 1], IO.rope[programKeyWD]];
IO.PutF[out, Nest["IMPORTS Convert, Rope", 1]];
IO.PutF[out, Nest["EXPORTS %gAux ~ {", 1], IO.rope[programKeyWD]];
IO.PutF[out, Nest["OPEN %g, %gAux;", 1],
IO.rope[programKeyWD],
IO.rope[programKeyWD]
];
IO.PutF[out, Nest["", 1]];
IO.PutF[out, Nest["ROPE: TYPE ~ Rope.ROPE;", 1]];
};
UnBundle: PROC [kind: ROPE] RETURNS [interface: ROPE, type: ROPE] ~ {
interface ← "FooP1V1";
type ← "CARD";
};
RecursiveItem: PROC [h: Handle, name: ROPE, kind: ROPE, programKeyWD: ROPE] RETURNS [x: ROPE] ~ {
entry: CType;
found: BOOLEAN;
interface: ROPE;
item: ROPE;
local: BOOLEAN;
type: ROPE ← kind;
value: Value;
[found, value] ← HashTable.Fetch[h.allTheTables.condensedTypeTable, kind];
IF (found)
THEN entry ← NARROW [value]
ELSE ERROR;
[item, local] ← UnDoable[kind, programKeyWD];
IF (NOT local) THEN [interface, type] ← UnBundle[kind];
SELECT entry.class FROM
boolean => {
x ← IO.PutFR["Convert.RopeFromBool[%g]", IO.rope[name]];
};
cardinal => {
x ← IO.PutFR["Convert.RopeFromCard[%g]", IO.rope[name]];
};
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]];
};
string => {
x ← IO.PutFR["Convert.RopeFromRope[%g]", IO.rope[name]];
};
unspecified => {
x ← IO.PutFR["Convert.RopeFromCard[%g]", IO.rope[name]];
};
enumeration => {
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[interface], IO.rope[type], IO.rope[name]];
};
array => {
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[interface], IO.rope[type], IO.rope[name]];
};
choice => {
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[interface], IO.rope[type], IO.rope[name]];
};
record => {
fieldList: CComponent ← entry.children;
Handle Empty Record as a special case because of compiler bug
IF (fieldList = NIL) THEN {
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[interface], IO.rope[type], IO.rope[name]];
RETURN;
};
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[interface], IO.rope[type], IO.rope[name]];
};
sequence => {
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[interface], IO.rope[type], IO.rope[name]];
};
error => { NULL }; -- always a constant!
procedure => { NULL }; -- always a constant!
ENDCASE => {
ERROR;
};
};
GenAuxImpl: PUBLIC PROC ~ {
aux: IO.STREAM;
failure: BOOLEAN;
h: Handle;
programKeyWD: ROPE;
GenerateItem: HashTable.EachPairAction ~ {
name: ROPE ← NARROW [key];
entry: CType ← NARROW [value];
item: ROPE;
local: BOOLEAN;
[item, local] ← UnDoable[name, programKeyWD];
IF (local) THEN {
SELECT entry.class FROM
boolean => {
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [p: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g(\"", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, Convert.RopeFromBool[p]];", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \")\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
cardinal => {
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [p: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g(\"", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, Convert.RopeFromCard[p]];", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \")\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
integer => {
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [p: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g(\"", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, Convert.RopeFromInt[p]];", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \")\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
longCardinal => {
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [p: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g(\"", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, Convert.RopeFromCard[p]];", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \")\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
longInteger => {
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [p: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g(\"", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, Convert.RopeFromInt[p]];", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \")\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
string => {
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [p: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g(\"", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, Convert.RopeFromRope[p]];", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \")\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
unspecified => {
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [p: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g(\"", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, Convert.RopeFromCard[p]];", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \")\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
enumeration => {
elementList: CComponent ← entry.children;
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [e: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["SELECT e FROM", 3]];
WHILE (elementList # NIL) DO
IO.PutF[aux, Nest["%g => x ← \"%g\";", 3],
IO.rope[elementList.name],
IO.rope[elementList.name]
];
elementList ← elementList.sibling;
ENDLOOP;
IO.PutF[aux, Nest["ENDCASE => x ← \"unknown %g\";", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["};", 1]];
};
array => {
name: ROPE ← "a[i]";
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [a: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g: [\";", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["FOR i: CARDINAL IN [0..%g) DO", 3],
IO.card[(entry.bound-1)]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, %g];", 3],
IO.rope[RecursiveItem[h, name, entry.children.type, programKeyWD]]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \", \"];", 3]];
IO.PutF[aux, Nest["ENDLOOP;", 2]];
name ← IO.PutFR["a[%g]", IO.card[(entry.bound-1)]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, %g];", 2],
IO.rope[RecursiveItem[h, name, entry.children.type, programKeyWD]]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \"]\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
choice => {
name: ROPE ← "c.type";
tag: CComponent ← entry.children;
variantList: CComponent ← entry.children.sibling; -- skipping tag item
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [c: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g(\";", 2],
IO.rope[item]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, %g];", 2],
IO.rope[RecursiveItem[h, name, tag.type, programKeyWD]]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \"): \"];", 2]];
IO.PutF[aux, Nest["WITH c SELECT FROM", 3]];
WHILE (variantList # NIL) DO
IO.PutF[aux, Nest["v: %g %g => {", 4],
IO.rope[variantList.name],
IO.rope[item]
];
name ← IO.PutFR["v.%g", IO.rope[variantList.name]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, %g];", 4],
IO.rope[RecursiveItem[h, name, variantList.type, programKeyWD]]
];
IO.PutF[aux, Nest["};", 3]];
variantList ← variantList.sibling;
ENDLOOP;
IO.PutF[aux, Nest["ENDCASE => { x ← Rope.Concat[x, \"Unknown\"]; };", 2]];
IO.PutF[aux, Nest["};", 1]];
};
record => {
name: ROPE ← "r.foo";
fieldList: CComponent ← entry.children;
Handle Empty Record as a special case because of compiler bug
IF (fieldList = NIL) THEN {
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [--r: %g,-- level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"[\";", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \"]\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
RETURN;
};
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [r: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"[\";", 2]];
WHILE (fieldList.sibling # NIL) DO
IO.PutF[aux, Nest["x ← Rope.Concat[x, \"%g: \"];", 2],
IO.rope[fieldList.name]
];
name ← IO.PutFR["r.%g", IO.rope[fieldList.name]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, %g];", 2],
IO.rope[RecursiveItem[h, name, fieldList.type, programKeyWD]]
];
fieldList ← fieldList.sibling;
ENDLOOP;
IO.PutF[aux, Nest["x ← Rope.Concat[x, \", \"];", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \"%g: \"];", 2],
IO.rope[fieldList.name]
];
name ← IO.PutFR["r.%g", IO.rope[fieldList.name]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, %g];", 2],
IO.rope[RecursiveItem[h, name, fieldList.type, programKeyWD]]
];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \"]\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
sequence => {
name: ROPE ← "s[i]";
IO.PutF[aux, Nest["", 1]];
IO.PutF[aux, "Expose%g: PUBLIC PROC [s: %g, level: NAT] RETURNS [x: ROPE] ~ {",
IO.rope[item],
IO.rope[item]
];
IO.PutF[aux, Nest["", 2]];
IO.PutF[aux, Nest["x ← \"%g: [\";", 2],
IO.rope[item],
];
IO.PutF[aux, Nest["FOR i: CARDINAL IN [0..s.length) DO", 3]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \"\\n\"];", 3]];
IO.PutF[aux, Nest["FOR i: CARDINAL IN [0..2*level) DO x ← Rope.Concat[x, \" \"]; ENDLOOP;", 3]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \"(\"];", 3]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, Convert.RopeFromCard[i]];", 3]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \") \"];", 3]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, %g];", 3],
IO.rope[RecursiveItem[h, name, entry.children.type, programKeyWD]]
];
IO.PutF[aux, Nest["ENDLOOP;", 2]];
IO.PutF[aux, Nest["x ← Rope.Concat[x, \"]\"];", 2]];
IO.PutF[aux, Nest["};", 1]];
};
error => { NULL }; -- always a constant!
procedure => { NULL }; -- always a constant!
ENDCASE => {
ERROR;
};
};
};
GenAuxImpl MAIN
h ← SIGNAL AquireState[];
programKeyWD ← IO.PutFR["%gP%gV%g",
IO.rope[h.programName],
IO.int[h.programNo],
IO.int[h.versionNo]
];
aux ← FS.StreamOpen[Rope.Cat[programKeyWD, "AuxImpl.Mesa"], $create];
Heading[aux, programKeyWD];
failure ← HashTable.Pairs[h.allTheTables.typeTable, GenerateItem];
IO.PutF[aux, Nest["", 0]];
IO.PutF[aux, Nest["}...", 0]];
IO.Close[aux];
};
}.