RoseTranslateWrite2.Mesa
Last Edited by: Spreitzer, September 18, 1985 9:03:29 pm PDT
Last Edited by: Barth, March 8, 1983 10:45 am
Last Edited by: Gasbarro, August 16, 1984 4:05:44 pm PDT
DIRECTORY Asserting, AssertingIO, Basics, Convert, FS, IO, RedBlackTree, Rope, RoseTranslateTypes, RoseTranslateInsides, TiogaFileOps, TiogaStreams;
RoseTranslateWrite2:
CEDAR
PROGRAM
IMPORTS AssertingIO, Convert, IO, RedBlackTree, Rope, TS: TiogaStreams, RoseTranslateInsides
EXPORTS RoseTranslateInsides =
BEGIN OPEN RoseTranslateTypes, RoseTranslateInsides;
WriteExpand:
PUBLIC
PROC [job: Job, name:
ROPE, ec:
LORA, cellDef: CellDef] =
BEGIN
TSNodeBreak[job.to];
job.to.PutF["%gExpand: PROC [thisCell: Cell, to: ExpansionReceiver] --ExpandProc-- = {", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
IF cellDef.forFn #
NIL
THEN {
job.to.PutF["args: REF %gArgs ← NARROW[thisCell.type.typeData];", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["{OPEN args;"];
TSNodeBreak[job.to]};
IF (cellDef.interfaceLiteral #
NIL)
AND (cellDef.interfaceLiteral.asList #
NIL)
THEN {
job.to.PutRope["PrivateLookupNode: PROC [name: ROPE] RETURNS [node: Node] = {node ← RoseCreate.LookupNode[from: thisCell, path: LIST[name]]};"];
TSNodeBreak[job.to];
};
IF cellDef.interfaceLiteral #
NIL
THEN
FOR iel: InterfaceEltList ← cellDef.interfaceLiteral.asList, iel.rest
WHILE iel #
NIL
DO
job.to.PutF[
"%g: Node ← PrivateLookupNode[\"%g\"];",
IO.rope[iel.first.name], IO.rope[iel.first.name]];
TSNodeBreak[job.to];
ENDLOOP;
job.to.PutF["others: SymbolTable ← RoseCreate.GetOthers[otherss, %g];", IO.refAny[name]];
TSNodeBreak[job.to];
job.partsAssertionsStream.PutF["\n%g\n", IO.refAny[name]];
job.nodeCreateHacks ← RedBlackTree.Create[GetNCHKey, CompareNCHs];
job.nchCount ← 0;
job.previewing ← TRUE;
FOR lora:
LORA ← ec, lora.rest
WHILE lora #
NIL
DO
WriteBinding:
PROC [b: Binding] =
BEGIN
WITH b.value
SELECT
FROM
sti: SignalTypeInvocation => WriteNodeInstance[job, b.name, sti.st, b.assertions, b.initialData, b.initialValue];
a: Application => WriteCellInstance[job, name, b.name, a, b.assertions];
id: ID => WriteWhateverInstance[job, b.name, id.rope, b.assertions, b.initialData, b.initialValue];
ENDCASE => ERROR;
END;
WITH lora.first
SELECT
FROM
cs: CedarChildren => NULL;
bl: BindingList => FOR bl ← bl, bl.rest WHILE bl # NIL DO WriteBinding[bl.first] ENDLOOP;
b: Binding => WriteBinding[b];
e: Equivalence => WriteEquivalence[job, e];
ENDCASE => ERROR;
ENDLOOP;
job.previewing ← FALSE;
FOR lora:
LORA ← ec, lora.rest
WHILE lora #
NIL
DO
WriteBinding:
PROC [b: Binding] =
BEGIN
WITH b.value
SELECT
FROM
sti: SignalTypeInvocation => WriteNodeInstance[job, b.name, sti.st, b.assertions, b.initialData, b.initialValue];
a: Application => WriteCellInstance[job, name, b.name, a, b.assertions];
id: ID => WriteWhateverInstance[job, b.name, id.rope, b.assertions, b.initialData, b.initialValue];
ENDCASE => ERROR;
END;
WITH lora.first
SELECT
FROM
cs: CedarChildren => InjectCedar[job, cs, impl];
bl: BindingList => FOR bl ← bl, bl.rest WHILE bl # NIL DO WriteBinding[bl.first] ENDLOOP;
b: Binding => WriteBinding[b];
e: Equivalence => WriteEquivalence[job, e];
ENDCASE => ERROR;
ENDLOOP;
IF cellDef.forFn #
NIL
THEN {
job.to.PutRope["};"]; TS.ChangeDepth[job.to, -1]};
job.to.PutRope["};"]; TS.ChangeDepth[job.to, -1];
job.partsAssertionsStream.PutRope[" .\n"];
END;
InjectCedar:
PUBLIC
PROC [job: Job, cc: CedarChildren, which: MesaFlavor] =
BEGIN
where: TiogaFileOps.Ref;
dest: IO.STREAM ← SELECT which FROM impl => job.to, intf => job.intfStream, ENDCASE => ERROR;
TSNodeBreak[dest];
dest.PutRope["--explicitly requested CEDAR:"];
TSNodeBreak[dest];
where ← TS.CurOutNode[dest];
TSNodeBreak[dest];
TS.CopyChildren[from: cc.parent, to: where];
END;
NodeCreateHack: TYPE = REF NodeCreateHackRep;
NodeCreateHackRep:
TYPE =
RECORD [
key, name: ROPE,
callCount: CARDINAL];
GetNCHKey:
PROC [data:
REF
ANY]
RETURNS [key:
ROPE]
--RedBlackTree.GetKey-- =
{nch: NodeCreateHack ← NARROW[data]; key ← nch.key};
CompareNCHs:
PROC [k, data:
REF
ANY]
RETURNS [c: Basics.Comparison]
--RedBlackTree.Compare-- =
BEGIN
s1: ROPE ← NARROW[k];
s2: ROPE ← GetNCHKey[data];
c ← s1.Compare[s2, FALSE];
END;
WriteNodeInstance:
PROC [job: Job, name:
ROPE, st: NodeType, assertions: Assertions, initialData, initialValue:
REF
ANY] =
BEGIN
initialExpression, format, initialDataExpression: ROPE ← NIL;
IF initialValue #
NIL
THEN
WITH initialValue
SELECT
FROM
ce: CedarExpression => initialExpression ← CedarExpressionRope[ce];
f: Formatted => {initialExpression ← CedarExpressionRope[f.value]; format ← Convert.RopeFromRope[f.format.rope]};
ENDCASE => ERROR;
IF initialData #
NIL
THEN
WITH initialData
SELECT
FROM
ce: CedarExpression => initialDataExpression ← CedarExpressionRope[ce];
ENDCASE => ERROR;
IF job.previewing
THEN
BEGIN
roseType: Mesa ← st.procs.MesaForSelf[st];
key: ROPE ← IO.PutFR["\"%q\" ← %g %g fmt %g", IO.rope[roseType.mesa], IO.rope[initialDataExpression], IO.rope[initialExpression], IO.rope[format]];
nch: NodeCreateHack ← NARROW[job.nodeCreateHacks.Lookup[key]];
IF nch =
NIL
THEN job.nodeCreateHacks.Insert[
nch ←
NEW [NodeCreateHackRep ← [
key: key,
name: NIL,
callCount: 0]],
key];
nch.callCount ← nch.callCount + 1;
END
ELSE
BEGIN
roseType: Mesa ← st.procs.MesaForSelf[st];
key: ROPE ← IO.PutFR["\"%q\" ← %g %g fmt %g", IO.rope[roseType.mesa], IO.rope[initialDataExpression], IO.rope[initialExpression], IO.rope[format]];
nch: NodeCreateHack ← NARROW[job.nodeCreateHacks.Lookup[key]];
ne: nodeEntry ← NEW [SymbolTableEntryRep[node] ← [name: name, value: node[st]]];
IF assertions #
NIL
THEN {
job.partsAssertionsStream.PutRope[Convert.RopeFromRope[name].Cat[" "]];
AssertingIO.Write[job.partsAssertionsStream, assertions];
job.partsAssertionsStream.PutRope["\n"];
};
IF job.things.Lookup[name] = NIL THEN job.things.Insert[ne, ne.name]
ELSE Whimper[nullSR, job, "node %g multiply defined", IO.rope[name]];
AddMesa[job, roseType];
IF nch.callCount >= nodeCreateHackThreshold
THEN
BEGIN
IF nch.name =
NIL
THEN
BEGIN
nch.name ← IO.PutFR["NodeCreateHack%g", IO.card[job.nchCount ← job.nchCount + 1]];
job.to.PutF["%g: PROC [name: ROPE] RETURNS [node: Node] = {node ← to.class.NodeInstance[erInstance: to.instance, name: name, type: %g, other: RoseCreate.GetOther[others, name]", IO.rope[nch.name], IO.rope[roseType.mesa]];
IF initialExpression # NIL THEN job.to.PutF[", initialValue: %g", IO.rope[initialExpression]];
IF format # NIL THEN job.to.PutF[", initialValueFormat: %g", IO.rope[format]];
IF initialDataExpression # NIL THEN job.to.PutF[", initData: %g", IO.rope[initialDataExpression]];
job.to.PutRope["]};"]; TSNodeBreak[job.to];
END;
job.to.PutF["%g: Node ← %g[\"%g\"", IO.rope[name], IO.rope[nch.name], IO.rope[name]];
END
ELSE
BEGIN
job.to.PutF["%g: Node ← to.class.NodeInstance[erInstance: to.instance, name: \"%g\", type: %g, other: RoseCreate.GetOther[others, \"%g\"]", IO.rope[name], IO.rope[name], IO.rope[roseType.mesa], IO.rope[name]];
IF initialExpression # NIL THEN job.to.PutF[", initialValue: %g", IO.rope[initialExpression]];
IF format # NIL THEN job.to.PutF[", initialValueFormat: %g", IO.rope[format]];
IF initialDataExpression # NIL THEN job.to.PutF[", initData: %g", IO.rope[initialDataExpression]];
END;
job.to.PutRope["];"];
TSNodeBreak[job.to];
END;
END;
nodeCreateHackThreshold: CARDINAL ← 3;
WriteCellInstance:
PROC [job: Job, defName, instanceName:
ROPE, a: Application, assertions: Assertions] =
BEGIN
ste: SymbolTableEntry;
cd: CellDef;
definedIn: ROPE;
typeNameExpr: ROPE;
fromSelf: BOOLEAN;
IF job.previewing THEN RETURN;
IF assertions #
NIL
THEN {
job.partsAssertionsStream.PutRope[Convert.RopeFromRope[instanceName].Cat[" "]];
AssertingIO.Write[job.partsAssertionsStream, assertions];
job.partsAssertionsStream.PutRope["\n"];
};
WITH a.subject
SELECT
FROM
id:
ID => {
lit: ROPE ← id.rope;
typeNameExpr ← IO.PutFR["\"%q\"", IO.rope[lit]];
ste ← NARROW[job.things.Lookup[lit]];
IF ste =
NIL
THEN
BEGIN
[] ← Complain[a.sr, job, "Cell Class %g undefined!", IO.rope[lit]];
cd ← NEW [CellDefRep ← []]; definedIn ← NIL;
IF lit # NIL THEN AddCellClass[job, NEW [SymbolTableEntryRep[cellClass] ← [name: lit, value: cellClass[isVar: FALSE, definedIn: definedIn, cd: cd]]]];
END
ELSE
WITH ste
SELECT
FROM
cce: ccEntry => {
fromSelf ← (definedIn ← cce.definedIn).Equal[job.rootName, FALSE];
cd ← cce.cd;
IF
NOT cce.isVar
THEN typeNameExpr ← IO.PutFR["\"%q\"", IO.rope[ste.name]]
ELSE {
typeNameExpr ← ste.name.Cat[".name"];
IF
NOT fromSelf
THEN {
typeNameExpr ← definedIn.Cat[".", typeNameExpr];
AddImport[job, definedIn];
};
};
};
ENDCASE =>
BEGIN
[] ← Complain[a.sr, job, "Can't instantiate %g like a Cell Class", IO.refAny[ste]];
definedIn ← NIL;
cd ← NEW [CellDefRep ← []];
END;
};
ia: Application => {s:
IO.
STREAM ←
IO.
ROS[];
sub: ID ← NARROW[ia.subject];
functionName: ROPE ← Rope.Cat["?", sub.rope, "?"];
ste: SymbolTableEntry ← NARROW[job.things.Lookup[sub.rope]];
ok: BOOL ← FALSE;
cd ← NEW [CellDefRep ← []];
IF ste #
NIL
THEN
WITH ste
SELECT
FROM
cfe: cfEntry => {
fromSelf ← (definedIn ← cfe.definedIn).Equal[job.rootName, FALSE];
IF fromSelf
THEN functionName ← sub.rope
ELSE {
functionName ← definedIn.Cat[".", sub.rope];
AddImport[job, definedIn];
};
cd ← cfe.cf.cd;
ok ← TRUE};
ENDCASE;
IF NOT ok THEN Whimper[ia.sr, job, "You tried to use %g as a CellTypeFunction name, but it ain't (it's a %g)", IO.rope[sub.rope], IO.refAny[ste]];
WriteCellFnInvocation[s, [nullSR, functionName, ia.args]];
typeNameExpr ← IO.RopeFromROS[s].Cat[".name"];
};
ENDCASE => ERROR;
job.to.PutF["[] ← to.class.CellInstance[erInstance: to.instance, instanceName: \"%g\", typeName: %g, other: RoseCreate.GetOther[others, \"%g\"], interfaceNodes: ", IO.rope[instanceName], IO.rope[typeNameExpr], IO.rope[instanceName]];
IF cd.interfaceLiteral # NIL THEN TypeCheck[job, defName, a.args, cd.interfaceLiteral, instanceName];
IF a.args #
NIL
THEN
BEGIN
job.to.PutRope["\""];
WITH a.args
SELECT
FROM
bl: BindingList => WriteBindingList[job.to, bl];
a: Args => WriteArgs[job.to, a];
ENDCASE => ERROR;
job.to.PutRope["\""];
END
ELSE job.to.PutRope["NIL"];
job.to.PutRope["];"];
TSNodeBreak[job.to];
END;
WriteWhateverInstance:
PROC [job: Job, name, class:
ROPE, assertions: Assertions, initialData, initialValue:
REF
ANY] =
BEGIN
sti: SignalTypeInvocation ← InstantiateSignalType[job, class, NIL];
IF sti # NIL THEN WriteNodeInstance[job, name, sti.st, assertions, initialData, initialValue];
END;
WriteEquivalence:
PROC [job: Job, e: Equivalence] = {
IF job.previewing THEN RETURN;
job.to.PutRope["to.class.Equivalence["];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["to.instance,"];
TSNodeBreak[job.to];
WriteNodeExpression[job.to, e.a];
job.to.PutRope[","];
TSNodeBreak[job.to];
WriteNodeExpression[job.to, e.b];
job.to.PutRope["];"];
TS.ChangeDepth[job.to, -1];
};
WriteNodeExpression:
PROC [to:
IO.
STREAM, a: Arg] = {
WITH a
SELECT
FROM
id: ID => to.PutF["NEW [NodeExpressionRep.primary ← [primary[%g, [whole[]]]]]", IO.rope[id.rope]];
a: Application => {
id: ID ← NARROW[a.subject];
to.PutRope["NEW [NodeExpressionRep.primary ← [primary["];
to.PutRope[id.rope];
WITH a.args
SELECT
FROM
as: Args =>
WITH as.args.first
SELECT
FROM
dd: Dotdot => to.PutF[", [range[%g, %g, %g]]]]]", IO.int[MIN[dd.first, dd.last]], IO.card[ABS[dd.last-dd.first]], IO.bool[dd.last >= dd.first]];
i: Int => to.PutF[", [number[%g]]]]]", IO.int[i.i]];
ENDCASE => ERROR;
ENDCASE => ERROR;
};
sb: SquareBracketed => {
to.PutRope["NEW [NodeExpressionRep.unnamedCons ← [unnamedCons[LIST["];
TS.ChangeDepth[to, 1];
WITH sb.subject
SELECT
FROM
as: Args => {
FOR al: ArgList ← as.args, al.rest
WHILE al #
NIL
DO
WriteNodeExpression[to, al.first];
IF al.rest # NIL THEN to.PutRope[","];
TSNodeBreak[to];
ENDLOOP;
};
ENDCASE => ERROR;
to.PutRope["]]]]"];
TS.ChangeDepth[to, -1];
};
cat: Cat => {
to.PutRope["NEW [NodeExpressionRep.catenate ← [catenate[LIST["];
TS.ChangeDepth[to, 1];
FOR al: ArgList ← cat.kittens, al.rest
WHILE al #
NIL
DO
WriteNodeExpression[to, al.first];
IF al.rest # NIL THEN to.PutRope[","];
TSNodeBreak[to];
ENDLOOP;
to.PutRope["]]]]"];
TS.ChangeDepth[to, -1];
};
ENDCASE => ERROR;
};
WriteInitializer:
PUBLIC
PROC [job: Job, name:
ROPE, cc: CedarChildren, cellDef: CellDef] =
BEGIN
dest: TiogaFileOps.Ref;
opend: ROPE ← NIL;
AddOpen:
PROC [open:
ROPE] =
{opend ← IF opend # NIL THEN opend.Cat[", ", open] ELSE open};
hasSimple: BOOL ← AuxKnown[name, cellDef, SimpleIO, Ref];
hasSwitch: BOOL ← AuxKnown[name, cellDef, SwitchIO, Ref];
hasDrive: BOOL ← AuxKnown[name, cellDef, Drive, Ref];
TSNodeBreak[job.to];
job.to.PutF["Initialize%g: Initializer = {", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
IF cellDef.forFn #
NIL
THEN {
job.to.PutF["args: REF %gArgs ← NARROW [cell.type.typeData];", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["{OPEN args;"];
TSNodeBreak[job.to];
};
IF cellDef.initializerSource #
NIL
THEN {
IF hasDrive
THEN {
job.to.PutF["drive: %g ← NARROW[cell.realCellStuff.newDriveAsAny];", IO.rope[GetAux[name, cellDef, Drive, Ref]]];
TSNodeBreak[job.to];
AddOpen["drive"];
};
IF hasSwitch
THEN {
job.to.PutF["sw: %g ← NARROW[cell.realCellStuff.switchIO];", IO.rope[GetAux[name, cellDef, SwitchIO, Ref]]];
TSNodeBreak[job.to];
IF NOT hasSimple THEN AddOpen["sw"];
};
IF hasSimple
THEN {
job.to.PutF["newIO: %g ← NARROW[cell.realCellStuff.newIO];", IO.rope[GetAux[name, cellDef, SimpleIO, Ref]]];
TSNodeBreak[job.to];
AddOpen["newIO"];
};
};
IF AuxKnown[name, cellDef, State, Ref]
AND AuxKnown[name, cellDef, State, Val]
THEN
BEGIN
job.to.PutF["state: %g ← %g;",
IO.rope[GetAux[name, cellDef, State, Ref]],
IO.rope[GetAux[name, cellDef, State, Val]]];
TSNodeBreak[job.to];
job.to.PutRope["cell.realCellStuff.state ← state;"];
TSNodeBreak[job.to];
IF cellDef.initializerSource # NIL THEN AddOpen["state"];
END;
IF cellDef.initializerSource #
NIL
THEN
BEGIN
job.to.PutRope["BEGIN"];
IF opend # NIL THEN job.to.PutF[" OPEN %g;", IO.rope[opend]];
dest ← TS.CurOutNode[job.to];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cc.parent, to: dest];
END;
IF cellDef.forFn #
NIL
THEN {
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
};
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
END;
WriteEval:
PUBLIC
PROC [job: Job, name:
ROPE, et: EvalType, cc: CedarChildren, cellDef: CellDef] =
BEGIN
opend: ROPE ← NIL;
AddOpen:
PROC [o:
ROPE] = {
opend ← IF opend = NIL THEN o ELSE (opend.Cat[", ", o])};
dest: TiogaFileOps.Ref;
hasSimple: BOOL ← AuxKnown[name, cellDef, SimpleIO, Ref];
hasSwitch: BOOL ← AuxKnown[name, cellDef, SwitchIO, Ref];
hasDrive: BOOL ← AuxKnown[name, cellDef, Drive, Ref];
TSNodeBreak[job.to];
job.to.PutF["%g%g: %g =",
IO.rope[name],
IO.rope[etNames[et]],
IO.rope[
SELECT et
FROM
InitQ, PropQ, InitUD, PropUD, FinalUD => "CellProc",
ValsChanged, EvalSimple => "SimpleEval",
EnumerateVicinity => "PROC [cell: Cell, portIndex: PortIndex, evenIfInput: BOOL ← FALSE, consume: PROC [PortIndex]]",
ENDCASE => ERROR]
];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"]; TSNodeBreak[job.to];
SELECT et
FROM
EnumerateVicinity => NULL;
InitQ, PropQ, InitUD, PropUD, FinalUD, ValsChanged => {
IF hasSwitch THEN AddOpen["sw"];
IF et = ValsChanged AND hasDrive THEN AddOpen["drive"];
IF cellDef.interfaceLiteral # NIL AND NOT cellDef.interfaceLiteral.hasSwitchElt THEN Whimper[cellDef.sr, job, "Cell class %g has a %g, but no switch-level interface elements!", IO.rope[name], IO.rope[etNames[et]]];
};
EvalSimple => {
IF hasDrive THEN AddOpen["drive"];
IF hasSimple THEN AddOpen["newIO"];
};
ENDCASE => ERROR;
IF cellDef.forFn #
NIL
THEN {
job.to.PutF["args: REF %gArgs ← NARROW[cell.type.typeData];", IO.rope[name]];
TSNodeBreak[job.to];
AddOpen["args"];
};
IF hasDrive
THEN {
job.to.PutF["drive: %g ← NARROW[cell.realCellStuff.newDriveAsAny];", IO.rope[GetAux[name, cellDef, Drive, Ref]]];
TSNodeBreak[job.to];
};
IF hasSwitch
THEN {
job.to.PutF["sw: %g ← NARROW[cell.realCellStuff.switchIO];", IO.rope[GetAux[name, cellDef, SwitchIO, Ref]]];
TSNodeBreak[job.to];
};
IF hasSimple THEN job.to.PutF["newIO: %g ← NARROW[cell.realCellStuff.newIO];", IO.rope[GetAux[name, cellDef, SimpleIO, Ref]] ];
IF AuxKnown[name, cellDef, State, Ref]
THEN
BEGIN
TSNodeBreak[job.to];
job.to.PutF["state: %g ← NARROW[cell.realCellStuff.state];", IO.rope[GetAux[name, cellDef, State, Ref]]];
AddOpen["state"];
END;
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"];
IF opend # NIL THEN job.to.PutF[" OPEN %g;", IO.rope[opend]];
dest ← TS.CurOutNode[job.to];
TSNodeBreak[job.to];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cc.parent, to: dest];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END;
END.