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;

ROPE: TYPE ~ Rope.ROPE;
Value: TYPE ~ HashTable.Value;


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


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


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

}.



lGenerateAuxImpl.mesa
Copyright c 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

Copied Types

Procs
Heading main program

Handle Empty Record as a special case because of compiler bug
Handle Empty Record as a special case because of compiler bug
GenAuxImpl MAIN 
ส˜š
œ™Icodešœ
ฯm
œ1™<K™3K™&—K™š
ฯk	˜	Kšœ
žœ˜Kšžœ
žœ˜Kšœ
žœ6˜EKšžœ
žœžœ+˜;Kšœžœžœ$˜4KšœžœOžœ˜u—J˜šฯnœžœ
ž˜Jšžœ
žœ
žœ˜/Jšžœ˜Jšžœ˜—J˜™J™Jšžœžœžœ
˜Jšœžœ˜K˜—™K˜šŸœžœžœžœ
žœžœžœžœžœ˜eKšœžœ˜#šžœ
žœ˜Kš
œ/˜/K˜-K˜—Kš
œ.˜.K˜K˜—šŸœžœžœ
žœ˜-K˜.Kšœ
žœ
˜Kšœžœ
˜K˜šŸ
œ˜(Kšœžœžœ˜Kšœžœ	˜Kšœžœ
˜Kšœžœ
˜K˜Kš
œ/˜/Kšžœ
žœžœ
žœ
˜šžœ
ž˜š
œ˜Kš
œ)˜)—Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜š
œ˜šžœ3žœ	žœ
ž˜JKš
œ ˜ Kšžœ
˜—K˜—Kšœžœ
˜Kšœ	žœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœ
žœ
˜˜šžœ3žœ	žœ
ž˜JKš
œ ˜ Kšžœ
˜—K˜—š
œ˜Kš
œ)˜)—Kšœ
žœ
˜Kšœžœ
˜Kšžœžœ
˜—K˜K˜—šŸœžœžœ˜.Kšœžœ
˜K˜
K˜
Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜K˜Kš
œN˜NKšžœ
žœžœ
žœ
˜Kšœžœ	˜K˜Kš
œ3˜3Kšžœžœ
žœ
˜K˜šžœ
ž˜Kšœ	žœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœ
žœ
˜Kšœžœ
˜Kšœ	žœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœ
žœ
˜Kšœ
žœ
˜Kšœžœ
˜Kšœ
žœ
˜Kšœžœ
˜Kšžœžœ
˜—Kš
œ1˜1Kš
œ5˜5Kš
œ˜K˜—šŸœ˜/Kšœžœžœ˜"Kšžœžœžœžœ˜DK˜—K˜šŸœ˜,Kšœžœžœ˜"šžœ
žœ*ž˜4Kšžœžœ˜,—K˜K˜—K™K˜K˜K˜1K˜K˜Kš
œ7˜7Kš
œ;˜;K˜Kš
œ:˜:K˜Kšžœ$˜&Kšžœ#˜%Kšžœ ˜"Kšžœžœ˜)Kš
œ5˜5Kšžœ˜Kšžœžœ˜K˜Kšžœ-žœ˜HKšžœ'˜)Kš
œ2˜2Kšžœžœ˜Kšžœ&žœ˜Ašžœ#˜%Kšžœ˜Kšžœ˜Kš
œ˜—Kšžœ˜Kšžœ2˜4K˜K˜Kš
œ˜K˜—šŸ
œžœ
žœ˜Kšœžœ
žœ
˜Kšœ	žœ
˜Kš
œ
˜
K™šŸ
œžœžœ˜!šžœ
˜Kš
œH˜HKšžœžœ˜Kšžœ˜Kšžœ˜
K˜—K˜—šŸœžœžœžœ˜1K˜šžœ7˜9Kšžœžœ˜Kšžœ˜Kšžœ˜Kšžœžœ˜K˜—K˜—šŸœ˜*Kšœžœžœ˜Kšœžœ	˜Kšœžœ
˜Kšœžœ
˜K˜Kš
œ/˜/Kšžœ
žœžœ
žœ
˜K˜šžœ
ž˜˜
K˜Kšžœžœžœ˜6šžœ-˜/Kšžœžœ˜Kšžœ˜K˜—šžœE˜GKšžœžœ˜Kšžœ3˜5K˜—šžœ>˜@Kšžœžœ˜Kšžœžœ˜Kšžœžœ˜Kšžœžœ˜K˜—K˜—š
œ˜Kš
œ2˜2K˜—˜Kš
ž˜K˜—˜Kš
ž˜K˜—š
œ
˜
Kš
œ2˜2K˜—š
œ˜Kšœžœ˜.Kš
œ!˜!K˜šžœ5˜7Kšžœžœ˜Kšžœ˜Kšžœ*˜,K˜—Kšžœ%žœžœ˜>šžœ?žœžœ
ž˜Xšžœ"˜$Kšžœžœ˜Kšžœ˜Kšžœ˜Kš
œ˜—šžœ-˜/Kšžœžœ˜KšžœB˜DKš
œ˜—Kšžœ
˜—šžœ&˜(Kšžœžœ˜Kšžœžœ˜Kšžœžœ˜—K˜—˜K˜Kšžœ žœžœ˜9šžœ7žœžœ
ž˜Pšžœ#˜%Kšžœžœ˜Kšžœ˜Kšžœ˜Kš
œ˜—Kšžœ
˜—šžœ&˜(Kšžœžœ˜Kšžœžœ˜Kšžœžœ˜—K˜—˜
Kšžœ
˜K˜—š
œ˜Kš
œ1˜1K˜—š
œ˜Kš
œ2˜2K˜—š
œ˜Kš
œ1˜1K˜—˜Kšžœ
˜K˜—˜šžœžœ
žœ˜Kš
œ=™=šžœi˜kKšžœžœ˜Kšžœ˜Kšžœ˜Kšžœžœ˜Kš
œ˜—Kšžœ
˜K˜—K˜Kšžœžœžœ˜7šžœ3žœ	žœ
ž˜Jšžœ9˜;Kšžœžœ˜Kšžœ˜KšžœB˜DKš
žœžœžœ
žœžœ˜2K˜—Kšžœ
˜—šžœ˜Kšžœžœ˜Kšžœžœ˜K˜—K˜—š
œ
˜
K˜Kšžœžœžœ˜6šžœ5˜7Kšžœžœ˜K˜—šžœE˜GKšžœžœ˜Kšžœ8˜:K˜—šžœ>˜@Kšžœžœ˜Kšžœžœ˜Kšžœžœ˜Kšžœžœ˜K˜—K˜—š
œ˜Kš
œ˜K˜—š
œ˜Kš
œ2˜2K˜—Kšžœžœ
˜—K˜K˜—šŸ
œžœžœžœžœžœ˜FKš
œ
˜
Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜K˜
K˜šŸœžœ˜šžœ˜šžœ˜šœžœ!˜'Kšžœ˜Kšžœ˜
Kš
œ˜—K˜
—šžœ˜Kšœžœ
˜"Kš
œE˜Ešœžœ$˜*Kšžœ˜Kšžœ˜Kšžœ˜
Kš
œ˜—K˜——K˜K˜—Kš
œN˜NKšžœ
žœžœ
žœ
˜šœžœ	˜K˜—Kš
œ3˜3K˜šžœ
ž˜˜
K˜K˜—š
œ˜Kšœžœ#žœ
˜8K˜—˜K˜
K˜—˜K˜K˜—š
œ
˜
Kšœžœ#žœ
˜8K˜—˜K˜K˜—š
œ˜K˜Kš
œ˜—˜
K˜K˜—š
œ˜Kšœžœ"žœ
˜7K˜—š
œ˜Kšœžœ#žœ
˜8K˜—š
œ˜Kšœžœ"žœ
˜7K˜—˜K˜K˜—˜šžœžœ
žœ˜Kš
œ=™=Kšœžœ
˜"Kš
œE˜Ešžœ˜šžœžœ%˜0Kšžœ˜Kšžœ˜
Kš
œ
˜
—šžœžœ(˜3Kšžœ˜Kšžœ˜Kšžœ˜
Kš
œ˜——Kšžœ
˜Kš
œ˜—K˜K˜—˜
K˜K˜—š
œ˜Kš
œ	˜	K˜—š
œ˜Kšœžœ#žœ
˜8K˜—Kšžœžœ
˜—K˜K˜—K˜Iheadšœžœ
™Kšœžœ˜Kšœžœ?˜GKš
œ˜K˜Kš
œB˜BK˜Kšžœžœ˜Kšžœ˜!Kšžœ˜K˜——K˜Jš
œ˜J˜J˜—…—(48ฎ