
<<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.