DIRECTORY
BasicTime USING [],
FS USING [StreamOpen],
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, TABLES, UnDoable],
SymTab USING [EachPairAction, Erase, Fetch, Insert, Pairs, Ref, Val];

GenerateAuxImpl: CEDAR PROGRAM
IMPORTS FS, IO, Rope, SiroccoPrivate, SymTab
EXPORTS SiroccoPrivate ~ {
OPEN SiroccoPrivate;
ROPE: TYPE ~ Rope.ROPE;

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


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

άGenerateAuxImpl.mesa
Copyright Σ 1986, 1987 by Xerox Corporation.  All rights reserved.
Bill Jackson (bj) June 6, 1987 9:56:45 pm PDT
Demers, January 6, 1987 3:59:17 pm PST

Heading main program

GenAuxImpl MAIN 
Κ
!˜š
œ™Icodeš
œB™BK™-K™&—K™š
Οk	˜	Kšœ
œ˜Kšœ
œ˜Kšœ
œœ+˜;Kšœœœ$˜4KšœœHœ˜nKšœœ9˜E—J˜šΟnœœ
˜Jšœ
œœ˜,Jšœ˜Jšœ˜Jšœœœ
˜J˜šžœœœœ
œœœœœ˜eKšœœ˜#šœ
œ˜Kš
œ/˜/K˜-K˜—Kš
œ.˜.K˜K˜—šžœœœ
œ˜-Kš
œ3˜3Kšœ
œ
˜Kšœœ
˜K˜šž
œ˜%Kšœœœ˜Kšœœ˜Kšœœ
˜Kšœœ
˜K˜Kš
œ/˜/Kšœœ	œ
œ
˜šœ
˜Kš
œ2˜2Kšœœ
˜
Kšœ
œ
˜Kšœ
œ
˜š
œ˜šœ3œ	œ
˜JKš
œ ˜ Kšœ
˜—K˜—Kšœœ
˜
Kšœ	œ
˜Kšœ	œ
˜Kšœ	œ
˜Kšœœ
˜
˜šœ3œ	œ
˜JKš
œ ˜ Kšœ
˜—K˜—Kš
œ0˜0Kšœœ
˜
Kšœ
œ
˜Kšœ
œ
˜Kšœ
œ
˜Kšœœ
˜—K˜K˜—šžœœœ˜.Kšœœ
˜Kš
œ˜K˜
Kšœœ
˜Kšœœ
˜Kšœœ
˜K˜Kš
œK˜KKšœ
œœ
œ
˜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š
œ2˜2Kš
œ˜K˜—šžœ˜,Kšœœœ˜"Kšœœœœ˜DK˜—K˜šžœ˜)Kšœœœ˜"šœ
œ*˜4Kšœœ˜,—K˜K˜—K™K˜K˜K˜1K˜Kš
œ˜Kš
œ4˜4Kš
œ8˜8K˜Kš
œ:˜:K˜Kšœ$˜&Kšœ#˜%Kšœ ˜"Kšœœ˜)Kš
œ2˜2Kšœ˜Kšœœ˜K˜Kšœ-œ˜HKšœ'˜)Kš
œ/˜/Kšœœ˜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š
œ?˜?Kš
œA˜AKš
œA˜Aš
œ˜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š
œ?˜?Kšœ	œ˜˜K˜šœ˜šœ˜Kšœœœ˜8K˜
—šœ˜Kšœœœ˜7šœ3œ	œ
˜Jšœ9˜;Kšœœ˜Kšœ˜KšœB˜DKš
œœœ
œœ˜2K˜—Kšœ
˜—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š
œ+˜+Kš
œA˜AKšœœ
˜—K˜—šž
œœœœœœ˜FKš
œ
˜
Kšœœ
˜Kšœœ
˜Kšœœ
˜Kš
œ˜šžœœ˜šœ˜šœ˜šœœ!˜'Kšœ˜Kšœ˜
Kš
œ˜—K˜
—šœ˜Kšœœ
˜"Kš
œE˜Ešœœ$˜*Kšœ˜Kšœ˜Kšœ˜
Kš
œ˜—K˜——K˜—Kš
œK˜KKšœœ	œ
œ
˜Kšœœ	˜Kš
œ3˜3šœ
˜K˜$Kšœœ#œ˜EKšœœ#œ˜GKšœœ#œ˜GK˜%Kš
œ#˜#K˜Kšœœ"œ˜EKšœœ"œ˜EK˜K˜%K˜"K˜K˜Kš
œ˜Kšœœ#œ˜GKšœœ
˜—K˜—Iheadšœœ
™Kšœœ˜Kšœœ?˜GKš
œ˜K˜Kš
œ?˜?K˜Kšœœ˜Kšœ˜!Kšœ˜K˜—Jš
œ˜J˜——…—%$3!