Heading:
PROC [out:
IO.
STREAM, programKeyWD:
ROPE] ~ {
SiroccoPrivate.FileHeader[out, Rope.Cat[programKeyWD, "Aux.Mesa"]];
IO.PutRope[out, Nest["DIRECTORY", 1]];
IO.PutF[out, Nest["%g;", 0], IO.rope[programKeyWD]];
IO.PutRope[out, Nest["", 0]];
IO.PutF[out, Nest["%gAux: CEDAR DEFINITIONS ~ {", 1], IO.rope[programKeyWD]];
IO.PutF[out, Nest["OPEN %g;", 1], IO.rope[programKeyWD]];
};
GenAuxDefs:
PUBLIC
PROC ~ {
aux: IO.STREAM;
failure: BOOLEAN;
h: Handle;
GenerateInterfaceItem: HashTable.EachPairAction ~ {
name: ROPE ← NARROW [key];
entry: CType ← NARROW [value];
item: ROPE;
local: BOOLEAN;
GenItem:
PROC ~ {
IO.PutF[aux,
"%gExpose%g: PROC [arg: %g, level: NAT] RETURNS [res: ROPE];%g",
IO.rope[Nest[NIL, 1]],
IO.rope[item],
IO.rope[item],
IO.rope[Nest[NIL,1]]
];
};
[item, local] ← UnDoable[name, h.programKeyWD];
IF (local)
THEN {
SELECT entry.class
FROM
array =>
GenItem[];
boolean =>
GenItem[];
bulkDataSink =>
NULL; -- can't print meaningfully
bulkDataSource =>
NULL; -- can't print meaningfully
cardinal =>
GenItem[];
choice =>
GenItem[];
enumeration =>
GenItem[];
error =>
NULL; -- always a constant!
integer =>
GenItem[];
longCardinal =>
GenItem[];
longInteger =>
GenItem[];
procedure =>
NULL; -- always a constant!
record => {
fieldList: CComponent ← entry.children;
Handle Empty Record as a special case because of compiler bug
IF (fieldList =
NIL)
THEN {
IO.PutF[aux,
"%gExpose%g: PROC [--arg: %g,-- level: NAT] RETURNS [res: ROPE];%g",
IO.rope[Nest[NIL, 1]],
IO.rope[item],
IO.rope[item],
IO.rope[Nest[NIL,1]]
];
RETURN };
GenItem[]
};
sequence =>
GenItem[];
string =>
GenItem[];
unspecified =>
GenItem[];
ENDCASE =>
ERROR;
};
};
GenAuxDefs MAIN
h ← SIGNAL AquireState[];
aux ← FS.StreamOpen[Rope.Cat[h.programKeyWD, "Aux.Mesa"], $create];
Heading[aux, h.programKeyWD];
failure ← HashTable.Pairs[h.allTheTables.typeTable, GenerateInterfaceItem];
IO.PutRope[aux, Nest[NIL, 0]];
IO.PutRope[aux, Nest["}...", 0]];
IO.Close[aux];
};