RoseTranslateWrite.Mesa
Last Edited by: Spreitzer, April 28, 1985 3:33:42 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, OrderedSymbolTableRef, Rope, RoseTranslateTypes, RoseTranslateInsides, TiogaFileOps, TiogaStreams;
RoseTranslateWrite:
CEDAR
PROGRAM
IMPORTS AssertingIO, Convert, FS, IO, OSTR: OrderedSymbolTableRef, Rope, 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];
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: ROPE ← NIL;
fnExpr: ROPE ← NIL;
ste: SymbolTableEntry;
fromSelf: BOOL;
cce: ccEntry ← NEW [SymbolTableEntryRep[cellClass] ← [name: name, value: cellClass[globvar: 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];
TS.EndNode[job.to];
job.to.PutF["%g: PUBLIC CellType ← ", IO.rope[name]];
WriteCellFnInvocation[job.to, [nullSR, fnExpr, a.args]];
job.to.PutRope[";"];
TS.EndNode[job.to];
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 WriteRegistration[job.regStream, "[]", 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[globvar: 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];
stop ← FALSE;
END;
job.things.EnumerateIncreasing[DeleteNode];
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];
ENDLOOP;
END;
WriteInterfaceSpec:
PROC [job: Job, ste: SymbolTableEntry] =
BEGIN
cellDef: CellDef;
definedIn: ROPE ← NIL;
fun, globvar: BOOL ← FALSE;
WITH ste
SELECT
FROM
cce: ccEntry => {fun ← FALSE; cellDef ← cce.cd; definedIn ← cce.definedIn; globvar ← cce.globvar};
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};
job.symbolsStream.PutF["%g %g %g %g ", IO.bool[fun], IO.rope[ste.name], IO.bool[globvar], IO.rope[job.rootName]];
IF cellDef.interfaceLiteral = NIL THEN job.symbolsStream.PutRope["F"]
ELSE {
tempo: IO.STREAM ← IO.ROS[];
IF cellDef.interfaceLiteral.asList #
NIL
THEN WriteInterface[tempo, cellDef.interfaceLiteral]
ELSE tempo.PutRope["[]"];
job.symbolsStream.PutF["\"%q\"\n", IO.rope[IO.RopeFromROS[tempo]]];
};
TS.EndNode[job.symbolsStream];
END;
WriteInterface:
PROC [to:
IO.
STREAM, interface: DigestedInterface] =
BEGIN
first: BOOLEAN ← TRUE;
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: BOOLEAN ← TRUE;
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: BOOLEAN ← TRUE;
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;
TS.EndNode[job.to];
job.to.PutF["%gStateRef: TYPE = REF %gStateRec;", IO.rope[name], IO.rope[name]];
TS.EndNode[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;
TS.EndNode[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]];
TS.EndNode[job.to];
job.to.PutF["TRUSTED {PrintTV.Print[tv: AMBridge.TVForReferent[NEW [%gArgs ← args]], put: to]};", IO.rope[name]];
TS.EndNode[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
TS.EndNode[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;"];
TS.EndNode[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]]];
TS.EndNode[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
TS.EndNode[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;"];
TS.EndNode[job.to];
};
job.to.PutF["driveAsAny ← %g;", IO.rope[GetAux[name, cellDef, Drive, Val]]];
TS.EndNode[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
TS.EndNode[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;"];
TS.EndNode[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.STREAM ← FS.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;
TS.EndNode[job.to];
job.to.PutF["%g: CellTestProc =", IO.rope[TestName[name, test, cellDef]]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"]; TS.EndNode[job.to];
job.to.PutF["simpleInstr: %g ← NARROW[simpleInstructions];", IO.rope[GetAux[name, cellDef, SimpleIO, Ref]]];
TS.EndNode[job.to];
IF switchToo
THEN {
job.to.PutF["switchInstr: %g ← NARROW[switchInstructions];", IO.rope[GetAux[name, cellDef, SwitchIO, Ref]]];
TS.EndNode[job.to];
};
IF test.stateToo
THEN {
job.to.PutF["state: %g ← NARROW[stateAsAny];", IO.rope[GetAux[name, cellDef, State, Ref]]];
TS.EndNode[job.to]};
IF cellDef.forFn #
NIL
THEN {
job.to.PutF["args: REF %gArgs ← NARROW[testeeType.typeData];", IO.rope[name]];
TS.EndNode[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];
TS.EndNode[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]]};
WriteComputation:
PROC [job: Job, name:
ROPE, cellFn: CellFn] =
BEGIN
TS.EndNode[job.to];
job.to.PutF["%gArgs: PUBLIC TYPE = RECORD [", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
FOR args: BindingList ← cellFn.args, args.rest
WHILE args #
NIL
DO
ce: CedarExpression ← NARROW[args.first.value];
job.to.PutF["%g: %g", IO.rope[args.first.name], IO.rope[CedarExpressionRope[ce]]];
IF args.rest # NIL THEN {job.to.PutRope[","]; TS.EndNode[job.to]};
ENDLOOP;
job.to.PutRope["];"];
TS.ChangeDepth[job.to, -1];
TS.EndNode[job.to];
IF cellFn.howToApply =
NIL
THEN
BEGIN
job.to.PutF["Old%g: TYPE = RECORD [args: %gArgs, ct: CellType];", IO.rope[name], IO.rope[name]];
TS.EndNode[job.to];
job.to.PutF["old%g: LIST OF Old%g ← NIL;", IO.rope[name], IO.rope[name]];
TS.EndNode[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"];
TS.EndNode[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]"];
TS.EndNode[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]];
TS.EndNode[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];
TS.EndNode[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;
TS.EndNode[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];
TS.EndNode[job.to];
TS.CopyChildren[from: cellDef.interfaceSource.parent, to: where];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END;
END.