RoseTranslateWrite.Mesa
Last Edited by: Spreitzer, September 6, 1984 5:32: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 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];
cs: CedarSource => InjectCedar[job, cs];
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[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.interfaceLiteral.asList # NIL AND cellDef.ioRefTypeName = NIL THEN cellDef.ioRefTypeName ← IO.PutFR["%gIORef", 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, cellDef.ioRefTypeName, cellDef.interfaceLiteral, fun];
WriteIOCreator[job, name, cellDef];
}
ELSE IF cellDef.ioCreatorGiven THEN WriteIOCreator[job, name, cellDef];
IF cellDef.interfaceSource # NIL THEN WriteInterfaceProc[job, name, cellDef];
IF cellDef.stateGiven THEN WriteState[job, name, cellDef.stateSource];
IF cellDef.expandGiven THEN WriteExpand[job, name, cellDef.expandCode.statements, cellDef];
IF cellDef.stateGiven OR cellDef.initializerGiven THEN WriteInitializer[job, name, cellDef.initializerSource, cellDef];
FOR et: EvalType IN EvalType DO
IF cellDef.evalsGiven[et] THEN WriteEval[job, name, et, cellDef.evalSources[et], cellDef];
ENDLOOP;
IF cellDef.bbTestGiven THEN WriteTest[job, name, FALSE, cellDef.bbTestSource, cellDef];
IF cellDef.stTestGiven THEN WriteTest[job, name, TRUE, cellDef.stTestSource, cellDef];
IF cellDef.initCTPropsGiven 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: ROPENIL;
fun, globvar: BOOLFALSE;
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 %g ", IO.bool[fun], IO.rope[ste.name], IO.bool[globvar], IO.rope[job.rootName], IO.bool[cellDef.initializerGiven]];
IF cellDef.interfaceLiteral = NIL THEN job.symbolsStream.PutRope["F"]
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]]];
};
TS.EndNode[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]];
cl: CedarLiteral => to.Put[IO.rope[cl.cedar]];
ENDCASE => ERROR;
END;
WriteState: PROC [job: Job, name: ROPE, cs: CedarSource] =
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: cs.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 [cell: Cell] --IOCreator-- = {", IO.rope[name]];
IF cellDef.ioCreatorGiven THEN {
dest: TiogaFileOps.Ref ← TS.CurOutNode[job.to];
IF cellDef.forFn # NIL THEN job.to.PutF["args: REF %gArgs ← NARROW[cell.type.typeData]; {OPEN args;", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
IF cellDef.forFn # NIL THEN job.to.PutRope["}"];
job.to.PutRope["};"];
TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cellDef.ioCreatorSource.parent, to: dest];
}
ELSE {
TS.ChangeDepth[job.to, 1];
IF cellDef.interfaceLiteral.hasSwitchElt THEN {
job.to.PutF["cell.realCellStuff.switchIO ← NEW [%gIORec];", IO.rope[name]];
TS.EndNode[job.to];
};
job.to.PutF["cell.realCellStuff.newIO ← NEW [%gIORec];", IO.rope[name]];
TS.EndNode[job.to];
job.to.PutF["cell.realCellStuff.oldIO ← NEW [%gIORec];", IO.rope[name]];
TS.EndNode[job.to];
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.initCTPropsGiven 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, stateToo: BOOL, cs: CedarSource, cellDef: CellDef] =
BEGIN
dest: TiogaFileOps.Ref;
TS.EndNode[job.to];
job.to.PutF["%g%gTest: CellTestProc =", IO.rope[name], IO.rope[IF stateToo THEN "ST" ELSE "BB"]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN"]; TS.EndNode[job.to];
job.to.PutF["instructions: %g ← NARROW[io];", IO.rope[cellDef.ioRefTypeName]];
TS.EndNode[job.to];
IF stateToo THEN {
job.to.PutF["state: %gStateRef ← NARROW[stateAsAny];", IO.rope[name]];
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: REF %gDrive ← NARROW[driveAsAny];", IO.rope[name]];
TS.ChangeDepth[job.to, 1];
job.to.PutRope["BEGIN OPEN "];
IF cellDef.forFn # NIL THEN job.to.PutRope["args, "];
IF stateToo THEN job.to.PutRope["state, "];
job.to.PutRope["instructions;"];
dest ← TS.CurOutNode[job.to];
TS.EndNode[job.to];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
TS.CopyChildren[from: cs.parent, to: dest];
job.to.PutRope["END;"];
TS.ChangeDepth[job.to, -1];
END;
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
cl: CedarLiteral ← NARROW[args.first.value];
job.to.PutF["%g: %g", IO.rope[args.first.name], IO.rope[cl.cedar]];
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.