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: 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.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: 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 %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.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]];
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.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, 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.