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