RoseTranslateWrite.Mesa
Last Edited by: Spreitzer, September 18, 1985 9:03:11 pm PDT
Last Edited by: Barth, February 12, 1985 7:02:05 pm PST
Last Edited by: Gasbarro, August 16, 1984 4:05:44 pm PDT
DIRECTORY AssertingIO, Basics, Convert, FS, IO, RedBlackTree, RedBlackTreeExtras, Rope, RoseTranslateTypes, RoseTranslateInsides, SignalTypeRegistration, TiogaFileOps, TiogaStreams;
RoseTranslateWrite: CEDAR PROGRAM
IMPORTS AssertingIO, Convert, FS, IO, RedBlackTree, RedBlackTreeExtras, Rope, SignalTypeRegistration, TS: TiogaStreams, RoseTranslateTypes, RoseTranslateInsides
EXPORTS RoseTranslateInsides =
BEGIN OPEN RoseTranslateTypes, RoseTranslateInsides;
TranslatePiece: PUBLIC PROC [job: Job, asAny: REF ANY] =
BEGIN
IF asAny # error THEN WITH asAny SELECT FROM
b: Binding => {
WITH b.value SELECT FROM
cf: CellFn => TranslateCellDef[cf.cd, b.name, job];
a: Application => TranslateCellFnResult[a, b.name, job];
ENDCASE => [] ← Complain[b.sr, job, "Can't translate binding of %g to %g", IO.rope[b.name], IO.refAny[b.value]];
IF b.assertions # NIL THEN [] ← Complain[b.sr, job, "Don't give assertions in top-level binding (to %g)", IO.rope[b.name]]};
cd: CellDef => TranslateCellDef[cd, NIL, job];
cc: CedarChildren => InjectCedar[job, cc, impl];
ic: InterfaceCedar => InjectCedar[job, ic.cc, intf];
ENDCASE => [] ← Complain[nullSR, job, "Got %g when expecting CEDAR or a CELL", IO.refAny[asAny]];
END;
TranslateCellFnResult: PROC [a: Application, name: ROPE, job: Job] =
BEGIN
fnName: ROPENIL;
fnExpr: ROPENIL;
ste: SymbolTableEntry;
fromSelf: BOOL;
cce: ccEntry ← NEW [SymbolTableEntryRep[cellClass] ← [name: name, value: cellClass[isVar: TRUE, definedIn: job.rootName, cd: NIL]]];
WITH a.subject SELECT FROM
id: ID => fnName ← id.rope;
ENDCASE => {
Whimper[a.sr, job, "Can't invoke %g", IO.refAny[a.subject]];
RETURN};
ste ← NARROW[job.things.Lookup[fnName]];
WITH ste SELECT FROM
cfe: cfEntry => {
fromSelf ← cfe.definedIn.Equal[job.rootName, FALSE];
IF fromSelf THEN fnExpr ← fnName ELSE {
fnExpr ← Rope.Cat[cfe.definedIn, ".", fnName];
AddImport[job, cfe.definedIn]};
cce.cd ← cfe.cf.cd;
};
ENDCASE => {
Whimper[a.sr, job, "Can't invoke %g", IO.refAny[ste]];
RETURN};
AddCellClass[job, cce];
WriteInterfaceSpec[job, cce];
TSNodeBreak[job.to];
job.to.PutF["%g: PUBLIC CellType ← ", IO.rope[name]];
WriteCellFnInvocation[job.to, [nullSR, fnExpr, a.args]];
job.to.PutRope[";"];
TSNodeBreak[job.to];
job.intfStream.PutF["%g: RoseTypes.CellType;", IO.rope[name]];
TSNodeBreak[job.intfStream];
END;
TranslateCellDef: PROC [cellDef: CellDef, name: ROPE, job: Job] =
BEGIN
cellFn: CellFn ← cellDef.forFn;
fun: BOOL ← cellFn # NIL;
typeNameExpr: ROPE;
IF name = NIL
THEN name ← IF cellDef.literalName # NIL
THEN cellDef.literalName
ELSE IO.PutFR["%gG%g", IO.rope[job.rootName], IO.card[job.symGen ← job.symGen+1]];
typeNameExpr ← IO.PutFR["\"%q\"", IO.rope[name]];
IF cellDef.interfaceLiteral # NIL AND cellDef.interfaceSource # NIL
THEN [] ← Complain[cellDef.sr, job, "Cell Type %g given both literal and procedural interface", IO.rope[name]];
AddInterfaceNodes[job, cellDef];
IF fun THEN WriteComputation[job, name, cellFn] ELSE WriteStaticCellDef[job, name, cellDef];
IF NOT cellDef.nameIsLiteral THEN WriteNameProc[job, name, cellDef];
IF fun AND cellDef.nameIsLiteral THEN Whimper[cellDef.sr, job, "CellType Function %g produces constant name (%g)", IO.rope[name], IO.rope[cellDef.literalName]];
IF cellDef.interfaceLiteral # NIL AND cellDef.interfaceLiteral.asList # NIL THEN {
cellDef.portCount ← WriteInterfaceDecls[job, name, GetAux[name, cellDef, SwitchIO, Ref], GetAux[name, cellDef, SimpleIO, Ref], cellDef, fun];
};
IF AuxKnown[name, cellDef, SwitchIO, Val] AND AuxKnown[name, cellDef, SimpleIO, Val] THEN WriteIOCreator[job, name, cellDef];
IF AuxKnown[name, cellDef, Drive, Val] THEN WriteDriveCreator[job, name, cellDef];
IF cellDef.interfaceSource # NIL THEN WriteInterfaceProc[job, name, cellDef];
IF cellDef.sfSource # NIL THEN WriteState[job, name, cellDef.sfSource];
IF cellDef.expandCode # NIL THEN WriteExpand[job, name, cellDef.expandCode.statements, cellDef];
IF AuxKnown[name, cellDef, State, Val] OR cellDef.initializerSource # NIL THEN WriteInitializer[job, name, cellDef.initializerSource, cellDef];
FOR et: EvalType IN EvalType DO
IF cellDef.evals[et] # NIL THEN WriteEval[job, name, et, cellDef.evals[et], cellDef];
ENDLOOP;
FOR tl: TestList ← cellDef.tests, tl.rest WHILE tl # NIL DO
WriteTest[job, name, tl.first, cellDef];
ENDLOOP;
IF cellDef.initCTPropsSource # NIL OR (cellDef.assertions # NIL) THEN WriteInitCTProps[job, name, cellDef];
RemoveNodes[job];
IF fun THEN {
cfe: cfEntry ← NEW [SymbolTableEntryRep[cellFn] ← [name: name, value: cellFn[definedIn: job.rootName, cf: cellFn]]];
AddCellFn[job, cfe]; WriteInterfaceSpec[job, cfe];
}
ELSE {
cce: ccEntry ← NEW [SymbolTableEntryRep[cellClass] ← [name: name, value: cellClass[isVar: FALSE, definedIn: job.rootName, cd: cellDef]]];
AddCellClass[job, cce]; WriteInterfaceSpec[job, cce];
};
END;
RemoveNodes: PROC [job: Job] =
BEGIN
DeleteNode: PROC [asAny: REF ANY] RETURNS [stop: BOOLEAN] =
BEGIN
ste: SymbolTableEntry ← NARROW[asAny];
IF ste.type = node THEN [] ← job.things.Delete[ste.name];
stop ← FALSE;
END;
RedBlackTreeExtras.StatelessEnumerateIncreasing[job.things, DeleteNode, SignalTypeRegistration.GetSymbolTableEntryKey];
END;
AddInterfaceNodes: PROC [job: Job, cellDef: CellDef] =
BEGIN
IF cellDef.interfaceLiteral # NIL
THEN FOR iel: InterfaceEltList ← cellDef.interfaceLiteral.asList, iel.rest WHILE iel # NIL DO
ne: nodeEntry ← NEW [SymbolTableEntryRep[node] ← [name: iel.first.name, value: node[iel.first.sti.st]]];
job.things.Insert[ne, ne.name];
ENDLOOP;
END;
WriteInterfaceSpec: PROC [job: Job, ste: SymbolTableEntry] =
BEGIN
cellDef: CellDef;
definedIn: ROPENIL;
fun, isVar: BOOLFALSE;
WITH ste SELECT FROM
cce: ccEntry => {fun ← FALSE; cellDef ← cce.cd; definedIn ← cce.definedIn; isVar ← cce.isVar};
cfe: cfEntry => {fun ← TRUE; cellDef ← cfe.cf.cd; definedIn ← cfe.definedIn};
ENDCASE => {Whimper[nullSR, job, "Can't write Symbol Table Entry %g", IO.refAny[ste]]; RETURN};
IF definedIn.Length[] = 0 THEN ERROR --WriteInterfaceSpec should only be called on things defined in this job--;
job.symbolsStream.PutF["%g %g %g %g ", IO.bool[fun], IO.rope[ste.name], IO.bool[isVar], IO.refAny[job.rootName]];
IF cellDef.interfaceLiteral = NIL THEN job.symbolsStream.PutRope["NIL"]
ELSE {
tempo: IO.STREAMIO.ROS[];
IF cellDef.interfaceLiteral.asList # NIL
THEN WriteInterface[tempo, cellDef.interfaceLiteral]
ELSE tempo.PutRope["[]"];
job.symbolsStream.PutF["\"%q\"\n", IO.rope[IO.RopeFromROS[tempo]]];
};
TSNodeBreak[job.symbolsStream];
END;
WriteInterface: PROC [to: IO.STREAM, interface: DigestedInterface] =
BEGIN
first: BOOLEANTRUE;
to.PutRope["["];
FOR iel: InterfaceEltList ← interface.asList, iel.rest WHILE iel # NIL DO
IF first THEN first ← FALSE ELSE to.PutRope[", "];
to.PutF["%g%g", IO.rope[iel.first.name], IO.rope[ways[iel.first.input][iel.first.output]]];
WriteInvocation[to, iel.first.sti.invocation];
ENDLOOP;
to.PutRope["]"];
END;
ways: ARRAY BOOLEAN OF ARRAY BOOLEAN OF ROPE ← [["??", ">"], ["<", "="]];
WriteCellFnInvocation: PUBLIC PROC [to: IO.STREAM, i: Invocation] =
BEGIN
to.PutRope[i.name];
IF i.parms # NIL THEN
BEGIN
to.PutRope["[["];
WITH i.parms SELECT FROM
bl: BindingList => WriteBindingList[to, bl];
a: Args => WriteArgs[to, a];
ENDCASE => ERROR;
to.PutRope["]]"];
END;
END;
WriteInvocation: PUBLIC PROC [to: IO.STREAM, i: Invocation] =
BEGIN
to.PutRope[i.name];
IF i.parms # NIL THEN
BEGIN
to.PutRope["["];
WITH i.parms SELECT FROM
bl: BindingList => WriteBindingList[to, bl];
a: Args => WriteArgs[to, a];
ENDCASE => ERROR;
to.PutRope["]"];
END;
END;
WriteBindingList: PUBLIC PROC [to: IO.STREAM, bl: BindingList] =
BEGIN
first: BOOLEANTRUE;
FOR bl ← bl, bl.rest WHILE bl # NIL DO
IF first THEN first ← FALSE ELSE to.PutRope[", "];
to.PutF["%g:", IO.rope[bl.first.name]];
WriteValue[to, bl.first.value];
ENDLOOP;
END;
WriteArgs: PUBLIC PROC [to: IO.STREAM, args: Args] =
BEGIN
first: BOOLEANTRUE;
FOR l: LIST OF Arg ← args.args, l.rest WHILE l # NIL DO
IF first THEN first ← FALSE ELSE to.PutRope[", "];
WriteValue[to, l.first];
ENDLOOP;
END;
WriteValue: PROC [to: IO.STREAM, value: REF ANY] =
BEGIN
WITH value SELECT FROM
id: ID => to.Put[IO.rope[id.rope]];
q: Quoted => to.Put[IO.rope[Convert.RopeFromRope[q.rope]]];
ri: Int => to.Put[IO.int[ri.i]];
rr: Reel => to.Put[IO.real[rr.r]];
ce: CedarExpression => to.Put[IO.rope[CedarExpressionRope[ce]]];
ENDCASE => ERROR;
END;
WriteState: PROC [job: Job, name: ROPE, cc: CedarChildren] =
BEGIN
dest: TiogaFileOps.Ref;
TSNodeBreak[job.to];
job.to.PutF["%gStateRef: TYPE = REF %gStateRec;", IO.rope[name], IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutF["%gStateRec: TYPE = RECORD [", IO.rope[name]];
dest ← TS.CurOutNode[job.to];
TS.ChangeDepth[job.to, 1];
job.to.PutF["];"]; TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cc.parent, to: dest];
END;
WriteNameProc: PROC [job: Job, name: ROPE, cellDef: CellDef] =
BEGIN
dest: TiogaFileOps.Ref;
TSNodeBreak[job.to];
job.to.PutF["%gName: PROC ", IO.rope[name]];
IF cellDef.forFn # NIL THEN job.to.PutF["[args: %gArgs] ", IO.rope[name]];
job.to.PutRope["RETURNS [name: ROPE] = {"];
IF cellDef.nameSource = NIL
THEN BEGIN
IF cellDef.forFn = NIL THEN Whimper[cellDef.sr, job, "Can only AutoName a computed Cell Type"];
AddImport[job, "PrintTV"];
AddImport[job, "AMBridge"];
AddImport[job, "IO"];
TS.ChangeDepth[job.to, 1];
job.to.PutF["to: IO.STREAM ← IO.ROS[]; to.PutRope[\"%q\"];", IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutF["TRUSTED {PrintTV.Print[tv: AMBridge.TVForReferent[NEW [%gArgs ← args]], put: to, depth: 2]};", IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutRope["name ← IO.RopeFromROS[to]"];
END
ELSE BEGIN
IF cellDef.forFn # NIL THEN job.to.PutRope["OPEN args;"];
dest ← TS.CurOutNode[job.to];
TS.ChangeDepth[job.to, 1];
TS.CopyChildren[from: cellDef.nameSource.parent, to: dest];
END;
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
END;
WriteIOCreator: PROC [job: Job, name: ROPE, cellDef: CellDef] =
BEGIN
TSNodeBreak[job.to];
job.to.PutF["Create%gIO: PROC [ct: CellType, switch: BOOL] RETURNS [ioAsAny: REF ANY] --IOCreator-- = {", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
IF cellDef.forFn # NIL THEN {
job.to.PutF["args: REF %gArgs ← NARROW[ct.typeData];", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["{OPEN args;"];
TSNodeBreak[job.to];
};
job.to.PutF["ioAsAny ← IF switch THEN %g ELSE %g;", IO.rope[GetAux[name, cellDef, SwitchIO, Val]], IO.rope[GetAux[name, cellDef, SimpleIO, Val]]];
TSNodeBreak[job.to];
IF cellDef.forFn # NIL THEN {
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
};
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
END;
WriteDriveCreator: PROC [job: Job, name: ROPE, cellDef: CellDef] =
BEGIN
TSNodeBreak[job.to];
job.to.PutF["Create%gDrive: PROC [ct: CellType] RETURNS [driveAsAny: REF ANY] --DriveCreator-- = {", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
IF cellDef.forFn # NIL THEN {
job.to.PutF["args: REF %gArgs ← NARROW[ct.typeData];", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["{OPEN args;"];
TSNodeBreak[job.to];
};
job.to.PutF["driveAsAny ← %g;", IO.rope[GetAux[name, cellDef, Drive, Val]]];
TSNodeBreak[job.to];
IF cellDef.forFn # NIL THEN {
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
};
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
END;
WriteInitCTProps: PROC [job: Job, name: ROPE, cellDef: CellDef] =
BEGIN
TSNodeBreak[job.to];
job.to.PutF["Initial%gProps: PROC ", IO.rope[name]];
IF cellDef.forFn # NIL THEN job.to.PutF["[args: %gArgs] ", IO.rope[name]];
job.to.PutRope["RETURNS [other: Assertions] = {"];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["other ← NIL;"];
TSNodeBreak[job.to];
IF cellDef.initCTPropsSource # NIL THEN {
dest: TiogaFileOps.Ref;
job.to.PutRope["--designer's part: --{"];
dest ← TS.CurOutNode[job.to];
IF cellDef.forFn # NIL THEN job.to.PutRope["OPEN args;"];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cellDef.initCTPropsSource.parent, to: dest];
};
IF cellDef.assertions # NIL THEN {
assertFileName: ROPE ← job.rootName.Cat[".", name, ".cellAssertions"];
ao: IO.STREAMFS.StreamOpen[assertFileName, create];
ao.PutF["-- %g.%g assertions, written %g\n\n", IO.rope[job.rootName], IO.rope[name], IO.time[]];
AssertingIO.Write[to: ao, assertions: cellDef.assertions];
ao.Close[];
job.to.PutF["other ← Asserting.Union[RoseCreate.AssertionsFromFile[\"%g\"], other];", IO.rope[assertFileName]];
AddImport[job, "Asserting"];
AddImport[job, "RoseCreate"];
};
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
END;
WriteTest: PROC [job: Job, name: ROPE, test: TestNote, cellDef: CellDef] =
BEGIN
dest: TiogaFileOps.Ref;
switchToo: BOOL ← cellDef.interfaceLiteral # NIL AND cellDef.interfaceLiteral.hasSwitchInstruction;
TSNodeBreak[job.to];
job.to.PutF["%g: CellTestProc =", IO.rope[TestName[name, test, cellDef]]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"]; TSNodeBreak[job.to];
job.to.PutF["simpleInstr: %g ← NARROW[simpleInstructions];", IO.rope[GetAux[name, cellDef, SimpleIO, Ref]]];
TSNodeBreak[job.to];
IF switchToo THEN {
job.to.PutF["switchInstr: %g ← NARROW[switchInstructions];", IO.rope[GetAux[name, cellDef, SwitchIO, Ref]]];
TSNodeBreak[job.to];
};
IF test.stateToo THEN {
job.to.PutF["state: %g ← NARROW[stateAsAny];", IO.rope[GetAux[name, cellDef, State, Ref]]];
TSNodeBreak[job.to]};
IF cellDef.forFn # NIL THEN {
job.to.PutF["args: REF %gArgs ← NARROW[testeeType.typeData];", IO.rope[name]];
TSNodeBreak[job.to]};
job.to.PutF["drive: %g ← NARROW[driveAsAny];", IO.rope[GetAux[name, cellDef, Drive, Ref]]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN OPEN drive, "];
IF cellDef.forFn # NIL THEN job.to.PutRope["args, "];
IF test.stateToo THEN job.to.PutRope["state, "];
job.to.PutRope["simpleInstr;"];
dest ← TS.CurOutNode[job.to];
TSNodeBreak[job.to];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: test.code.parent, to: dest];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END;
TestName: PUBLIC PROC [name: ROPE, test: TestNote, cellDef: CellDef] RETURNS [ROPE] =
{RETURN [name.Cat["Test", test.name]]};
WriteStaticCellDef: PROC [job: Job, name: ROPE, cellDef: CellDef] = {
job.intfStream.PutF["%g: RoseTypes.CellType;", IO.rope[name]];
TSNodeBreak[job.intfStream];
job.to.PutF["%g: PUBLIC CellType;", IO.rope[name]];
TSNodeBreak[job.to];
WriteRegistration[job.regStream, name, name, cellDef]
};
WriteComputation: PROC [job: Job, name: ROPE, cellFn: CellFn] =
BEGIN
TSNodeBreak[job.to];
job.intfStream.PutF["%g: PROC [args: %gArgs] RETURNS [ct: RoseTypes.CellType];", IO.rope[name], IO.rope[name]];
TS.ChangeDepth[job.intfStream, 1];
job.intfStream.PutF["%gArgs: TYPE = RECORD [", IO.rope[name]];
TS.ChangeDepth[job.intfStream, 1];
FOR args: BindingList ← cellFn.args, args.rest WHILE args # NIL DO
ce: CedarExpression ← NARROW[args.first.value];
job.intfStream.PutF["%g: %g", IO.rope[args.first.name], IO.rope[CedarExpressionRope[ce]]];
IF args.rest # NIL THEN {job.intfStream.PutRope[","]; TSNodeBreak[job.intfStream]};
ENDLOOP;
job.intfStream.PutRope["];"];
TS.ChangeDepth[job.intfStream, -1];
TS.ChangeDepth[job.intfStream, -1];
IF cellFn.howToApply = NIL THEN
BEGIN
job.to.PutF["Old%g: TYPE = RECORD [args: %gArgs, ct: CellType];", IO.rope[name], IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutF["old%g: LIST OF Old%g ← NIL;", IO.rope[name], IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutF["%g: PUBLIC PROC [args: %gArgs] RETURNS [ct: CellType]", IO.rope[name], IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["= BEGIN"];
TSNodeBreak[job.to];
job.to.PutF["FOR old: LIST OF Old%g ← old%g, old.rest WHILE old # NIL DO", IO.rope[name], IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutF["IF old.first.args = args THEN RETURN [old.first.ct]"];
TSNodeBreak[job.to];
job.to.PutRope["ENDLOOP;"];
TS.ChangeDepth[job.to, -1];
WriteRegistration[to: job.to, result: "ct", name: name, cellDef: cellFn.cd];
job.to.PutF["old%g ← CONS[[args, ct], old%g];", IO.rope[name], IO.rope[name]];
TSNodeBreak[job.to];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END
ELSE BEGIN
where: TiogaFileOps.Ref;
job.to.PutF["%g: PUBLIC PROC [args: %gArgs] RETURNS [ct: CellType]", IO.rope[name], IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["= BEGIN OPEN args;"];
where ← TS.CurOutNode[job.to];
TSNodeBreak[job.to];
TS.CopyChildren[from: cellFn.howToApply.parent, to: where];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END;
END;
WriteInterfaceProc: PROC [job: Job, name: ROPE, cellDef: CellDef] =
BEGIN
where: TiogaFileOps.Ref;
TSNodeBreak[job.to];
job.to.PutF["Create%gPorts: PROC ", IO.rope[name]];
IF cellDef.forFn # NIL THEN job.to.PutF["[args: %gArgs] ", IO.rope[name]];
job.to.PutRope["RETURNS [ports: Ports] ="];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"];
IF cellDef.forFn # NIL THEN job.to.PutRope[" OPEN args;"];
where ← TS.CurOutNode[job.to];
TSNodeBreak[job.to];
TS.CopyChildren[from: cellDef.interfaceSource.parent, to: where];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END;
END.