
    <<RoseTranslateWrite2.Mesa>>
    <<Last Edited by: Spreitzer, July 2, 1985 5:22:08 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 Asserting, AssertingIO, Basics, Convert, FS, IO, OrderedSymbolTableRef, Rope, RoseTranslateTypes, RoseTranslateInsides, 
    TiogaFileOps, TiogaStreams;

    RoseTranslateWrite2: CEDAR PROGRAM
        IMPORTS AssertingIO, Convert, IO, OSTR: OrderedSymbolTableRef, Rope, TS: TiogaStreams, RoseTranslateInsides
        EXPORTS RoseTranslateInsides =

    BEGIN OPEN RoseTranslateTypes, RoseTranslateInsides;

    WriteExpand: PUBLIC PROC [job: Job, name: ROPE, ec: LORA, cellDef: CellDef] =
        BEGIN
        TS.EndNode[job.to];
        job.to.PutF["%gExpand: PROC [thisCell: Cell, to: ExpansionReceiver] --ExpandProc-- = {", IO.rope[name]];
        TS.ChangeDepth[job.to, 1];
        IF cellDef.forFn # NIL THEN {
            job.to.PutF["args: REF %gArgs _ NARROW[thisCell.type.typeData];", IO.rope[name]];
            TS.ChangeDepth[job.to, 1];
            job.to.PutRope["{OPEN args;"];
            TS.EndNode[job.to]};
        IF (cellDef.interfaceLiteral # NIL) AND (cellDef.interfaceLiteral.asList # NIL) THEN {
            job.to.PutRope["PrivateLookupNode: PROC [name: ROPE] RETURNS [node: Node] = {node _ RoseCreate.LookupNode[from: thisCell, path: 
            LIST[name]]};"];
            TS.EndNode[job.to];
            };
        IF cellDef.interfaceLiteral # NIL THEN FOR iel: InterfaceEltList _ cellDef.interfaceLiteral.asList, iel.rest WHILE iel # NIL DO
            job.to.PutF[
                "%g: Node _ PrivateLookupNode[\"%g\"];",
                IO.rope[iel.first.name], IO.rope[iel.first.name]];
            TS.EndNode[job.to];
            ENDLOOP;
        job.to.PutF["others: SymbolTable _ RoseCreate.GetOthers[otherss, %g];", IO.refAny[name]];
        TS.EndNode[job.to];
        job.partsAssertionsStream.PutF["\n%g\n", IO.refAny[name]];
        job.nodeCreateHacks _ OSTR.CreateTable[CompareNCHs];
        job.nchCount _ 0;
        job.previewing _ TRUE;
        FOR lora: LORA _ ec, lora.rest WHILE lora # NIL DO
            WriteBinding: PROC [b: Binding] =
                BEGIN
                WITH b.value SELECT FROM
                    sti: SignalTypeInvocation => WriteNodeInstance[job, b.name, sti.st, b.assertions, b.initialData, b.initialValue];
                    a: Application => WriteCellInstance[job, name, b.name, a, b.assertions];
                    id: ID => WriteWhateverInstance[job, b.name, id.rope, b.assertions, b.initialData, b.initialValue];
                    ENDCASE => ERROR;
                END;
            WITH lora.first SELECT FROM
                cs: CedarChildren => NULL;
                bl: BindingList => FOR bl _ bl, bl.rest WHILE bl # NIL DO WriteBinding[bl.first] ENDLOOP;
                b: Binding => WriteBinding[b];
                e: Equivalence => WriteEquivalence[job, e];
                ENDCASE => ERROR;
            ENDLOOP;
        job.previewing _ FALSE;
        FOR lora: LORA _ ec, lora.rest WHILE lora # NIL DO
            WriteBinding: PROC [b: Binding] =
                BEGIN
                WITH b.value SELECT FROM
                    sti: SignalTypeInvocation => WriteNodeInstance[job, b.name, sti.st, b.assertions, b.initialData, b.initialValue];
                    a: Application => WriteCellInstance[job, name, b.name, a, b.assertions];
                    id: ID => WriteWhateverInstance[job, b.name,  id.rope, b.assertions, b.initialData, b.initialValue];
                    ENDCASE => ERROR;
                END;
            WITH lora.first SELECT FROM
                cs: CedarChildren => InjectCedar[job, cs];
                bl: BindingList => FOR bl _ bl, bl.rest WHILE bl # NIL DO WriteBinding[bl.first] ENDLOOP;
                b: Binding => WriteBinding[b];
                e: Equivalence => WriteEquivalence[job, e];
                ENDCASE => ERROR;
            ENDLOOP;
        IF cellDef.forFn # NIL THEN {
            job.to.PutRope["};"]; TS.ChangeDepth[job.to, -1]};
        job.to.PutRope["};"]; TS.ChangeDepth[job.to, -1];
        job.partsAssertionsStream.PutRope[" .\n"];
        END;

    InjectCedar: PUBLIC PROC [job: Job, cc: CedarChildren] =
        BEGIN
        where: TiogaFileOps.Ref;
        TS.EndNode[job.to];
        job.to.PutRope["--explicitly requested CEDAR:"];
        TS.EndNode[job.to];
        where _ TS.CurOutNode[job.to];
        TS.EndNode[job.to];
        TS.CopyChildren[from: cc.parent, to: where];
        END;

    NodeCreateHack: TYPE = REF NodeCreateHackRep;
    NodeCreateHackRep: TYPE = RECORD [
        key, name: ROPE,
        callCount: CARDINAL];

    CompareNCHs: PROC [r1, r2: REF ANY] RETURNS [c: Basics.Comparison] =
        BEGIN
        Key: PROC [r: REF ANY] RETURNS [k: ROPE] = {k _ WITH r SELECT FROM
            x: ROPE => x,
            nch: NodeCreateHack => nch.key,
            ENDCASE => ERROR};
        c _ Key[r1].Compare[Key[r2]];
        END;

    WriteNodeInstance: PROC [job: Job, name: ROPE, st: NodeType, assertions: Assertions, initialData, initialValue: REF ANY] =
        BEGIN
        initialExpression, format, initialDataExpression: ROPE _ NIL;
        IF initialValue # NIL THEN WITH initialValue SELECT FROM
            ce: CedarExpression => initialExpression _ CedarExpressionRope[ce];
            f: Formatted => {initialExpression _ CedarExpressionRope[f.value]; format _ Convert.RopeFromRope[f.format.rope]};
            ENDCASE => ERROR;
        IF initialData # NIL THEN WITH initialData SELECT FROM
            ce: CedarExpression => initialDataExpression _ CedarExpressionRope[ce];
            ENDCASE => ERROR;
        IF job.previewing THEN BEGIN
            roseType: Mesa _ st.procs.MesaForSelf[st];
            key: ROPE _ IO.PutFR["\"%q\" _ %g %g fmt %g", IO.rope[roseType.mesa], IO.rope[initialDataExpression], IO.rope[initialExpression], 
            IO.rope[format]];
            nch: NodeCreateHack _ NARROW[job.nodeCreateHacks.Lookup[key]];
            IF nch = NIL THEN job.nodeCreateHacks.Insert[nch _ NEW [NodeCreateHackRep _ [
                key: key,
                name: NIL,
                callCount: 0]]];
            nch.callCount _ nch.callCount + 1;
            END
        ELSE BEGIN
            roseType: Mesa _ st.procs.MesaForSelf[st];
            key: ROPE _ IO.PutFR["\"%q\" _ %g %g fmt %g", IO.rope[roseType.mesa], IO.rope[initialDataExpression], IO.rope[initialExpression], 
            IO.rope[format]];
            nch: NodeCreateHack _ NARROW[job.nodeCreateHacks.Lookup[key]];
            ne: nodeEntry _ NEW [SymbolTableEntryRep[node] _ [name: name, value: node[st]]];
            IF assertions # NIL THEN {
                job.partsAssertionsStream.PutRope[Convert.RopeFromRope[name].Cat[" "]];
                AssertingIO.Write[job.partsAssertionsStream, assertions];
                job.partsAssertionsStream.PutRope["\n"];
                };
            IF job.things.Lookup[name] = NIL THEN job.things.Insert[ne]
            ELSE Whimper[nullSR, job, "node %g multiply defined", IO.rope[name]];
            AddMesa[job, roseType];
            IF nch.callCount >= nodeCreateHackThreshold THEN BEGIN
                IF nch.name = NIL THEN BEGIN
                    nch.name _ IO.PutFR["NodeCreateHack%g", IO.card[job.nchCount _ job.nchCount + 1]];
                    job.to.PutF["%g: PROC [name: ROPE] RETURNS [node: Node] = {node _ to.class.NodeInstance[erInstance: to.instance, name: name, type: 
                    %g, other: RoseCreate.GetOther[others, name]", IO.rope[nch.name], IO.rope[roseType.mesa]];
                    IF initialExpression # NIL THEN job.to.PutF[", initialValue: %g", IO.rope[initialExpression]];
                    IF format # NIL THEN job.to.PutF[", initialValueFormat: %g", IO.rope[format]];
                    IF initialDataExpression # NIL THEN job.to.PutF[", initData: %g", IO.rope[initialDataExpression]];
                    job.to.PutRope["]};"]; TS.EndNode[job.to];
                    END;
                job.to.PutF["%g: Node _ %g[\"%g\"", IO.rope[name], IO.rope[nch.name], IO.rope[name]];
                END
            ELSE BEGIN
                job.to.PutF["%g: Node _ to.class.NodeInstance[erInstance: to.instance, name: \"%g\", type: %g, other: RoseCreate.GetOther[others, 
                \"%g\"]", IO.rope[name], IO.rope[name], IO.rope[roseType.mesa], IO.rope[name]];
                IF initialExpression # NIL THEN job.to.PutF[", initialValue: %g", IO.rope[initialExpression]];
                IF format # NIL THEN job.to.PutF[", initialValueFormat: %g", IO.rope[format]];
                IF initialDataExpression # NIL THEN job.to.PutF[", initData: %g", IO.rope[initialDataExpression]];
                END;
            job.to.PutRope["];"];
            TS.EndNode[job.to];
            END;
        END;

    nodeCreateHackThreshold: CARDINAL _ 3;

    WriteCellInstance: PROC [job: Job, defName, instanceName: ROPE, a: Application, assertions: Assertions] =
        BEGIN
        ste: SymbolTableEntry;
        cd: CellDef;
        definedIn: ROPE;
        typeNameExpr: ROPE;
        fromSelf: BOOLEAN;
        IF job.previewing THEN RETURN;
        IF assertions # NIL THEN {
            job.partsAssertionsStream.PutRope[Convert.RopeFromRope[instanceName].Cat[" "]];
            AssertingIO.Write[job.partsAssertionsStream, assertions];
            job.partsAssertionsStream.PutRope["\n"];
            };
        WITH a.subject SELECT FROM
            id: ID => {
                lit: ROPE _ id.rope;
                typeNameExpr _ IO.PutFR["\"%q\"", IO.rope[lit]];
                ste _ NARROW[job.things.Lookup[lit]];
                IF ste = NIL THEN
                    BEGIN
                    [] _ Complain[a.sr, job, "Cell Class %g undefined!", IO.rope[lit]];
                    cd _ NEW [CellDefRep _ []]; definedIn _ NIL;
                    IF lit # NIL THEN AddCellClass[job, NEW [SymbolTableEntryRep[cellClass] _ [name: lit, value: cellClass[globvar: FALSE, definedIn: 
                    definedIn, cd: cd]]]];
                    END
                ELSE WITH ste SELECT FROM
                    cce: ccEntry => {
                        fromSelf _ (definedIn _ cce.definedIn).Equal[job.rootName, FALSE];
                        cd _ cce.cd;
                        IF NOT cce.globvar
                            THEN typeNameExpr _ IO.PutFR["\"%q\"", IO.rope[ste.name]]
                            ELSE {
                                typeNameExpr _ ste.name.Cat[".name"];
                                IF NOT fromSelf
                                    THEN {
                                        typeNameExpr _ definedIn.Cat[".", typeNameExpr];
                                        AddImport[job, definedIn];
                                        };
                                };
                        };
                    ENDCASE => BEGIN
                        [] _ Complain[a.sr, job, "Can't instantiate %g like a Cell Class", IO.refAny[ste]];
                        definedIn _ NIL;
                        cd _ NEW [CellDefRep _ []];
                        END;
                };
            ia: Application => {s: IO.STREAM _ IO.ROS[];
                sub: ID _ NARROW[ia.subject];
                functionName: ROPE _ Rope.Cat["?", sub.rope, "?"];
                ste: SymbolTableEntry _ NARROW[job.things.Lookup[sub.rope]];
                ok: BOOL _ FALSE;
                cd _ NEW [CellDefRep _ []];
                IF ste # NIL THEN WITH ste SELECT FROM
                    cfe: cfEntry => {
                        fromSelf _ (definedIn _ cfe.definedIn).Equal[job.rootName, FALSE];
                        IF fromSelf
                            THEN functionName _ sub.rope
                            ELSE {
                                functionName _ definedIn.Cat[".", sub.rope];
                                AddImport[job, definedIn];
                                };
                        cd _ cfe.cf.cd;
                        ok _ TRUE};
                    ENDCASE;
                IF NOT ok THEN Whimper[ia.sr, job, "You tried to use %g as a CellTypeFunction name, but it ain't (it's a %g)", IO.rope[sub.rope], 
                IO.refAny[ste]];
                WriteCellFnInvocation[s, [nullSR, functionName, ia.args]];
                typeNameExpr _ IO.RopeFromROS[s].Cat[".name"];
                };
            ENDCASE => ERROR;
        job.to.PutF["[] _ to.class.CellInstance[erInstance: to.instance, instanceName: \"%g\", typeName: %g, other: 
        RoseCreate.GetOther[others, \"%g\"], interfaceNodes: ", IO.rope[instanceName], IO.rope[typeNameExpr], 
        IO.rope[instanceName]];
        IF cd.interfaceLiteral # NIL THEN TypeCheck[job, defName, a.args, cd.interfaceLiteral, instanceName];
        IF a.args # NIL THEN
            BEGIN
            job.to.PutRope["\""];
            WITH a.args SELECT FROM
                bl: BindingList => WriteBindingList[job.to, bl];
                a: Args => WriteArgs[job.to, a];
                ENDCASE => ERROR;
            job.to.PutRope["\""];
            END
        ELSE job.to.PutRope["NIL"];
        job.to.PutRope["];"];
        TS.EndNode[job.to];
        END;

    WriteWhateverInstance: PROC [job: Job, name, class: ROPE, assertions: Assertions, initialData, initialValue: REF ANY] =
        BEGIN
        sti: SignalTypeInvocation _ InstantiateSignalType[job, class, NIL];
        IF sti # NIL THEN WriteNodeInstance[job, name, sti.st, assertions, initialData, initialValue];
        END;

    WriteEquivalence: PROC [job: Job, e: Equivalence] = {
        IF job.previewing THEN RETURN;
        job.to.PutRope["to.class.Equivalence["];
        TS.ChangeDepth[job.to, 1];
        job.to.PutRope["to.instance,"];
        TS.EndNode[job.to];
        WriteNodeExpression[job.to, e.a];
        job.to.PutRope[","];
        TS.EndNode[job.to];
        WriteNodeExpression[job.to, e.b];
        job.to.PutRope["];"];
        TS.ChangeDepth[job.to, -1];
        };

    WriteNodeExpression: PROC [to: IO.STREAM, a: Arg] = {
        WITH a SELECT FROM
            id: ID => to.PutF["NEW [NodeExpressionRep.primary _ [primary[%g, [whole[]]]]]", IO.rope[id.rope]];
            a: Application => {
                id: ID _ NARROW[a.subject];
                to.PutRope["NEW [NodeExpressionRep.primary _ [primary["];
                to.PutRope[id.rope];
                WITH a.args SELECT FROM
                    as: Args => WITH as.args.first SELECT FROM
                        dd: Dotdot => to.PutF[", [range[%g, %g, %g]]]]]", IO.int[MIN[dd.first, dd.last]], IO.card[ABS[dd.last-dd.first]], IO.bool[dd.last 
                        >= dd.first]];
                        i: Int => to.PutF[", [number[%g]]]]]", IO.int[i.i]];
                        ENDCASE => ERROR;
                    ENDCASE => ERROR;
                };
            sb: SquareBracketed => {
                to.PutRope["NEW [NodeExpressionRep.unnamedCons _ [unnamedCons[LIST["];
                TS.ChangeDepth[to, 1];
                WITH sb.subject SELECT FROM
                    as: Args => {
                        FOR al: ArgList _ as.args, al.rest WHILE al # NIL DO
                            WriteNodeExpression[to, al.first];
                            IF al.rest # NIL THEN to.PutRope[","];
                            TS.EndNode[to];
                            ENDLOOP;
                        };
                    ENDCASE => ERROR;
                to.PutRope["]]]]"];
                TS.ChangeDepth[to, -1];
                };
            cat: Cat => {
                to.PutRope["NEW [NodeExpressionRep.catenate _ [catenate[LIST["];
                TS.ChangeDepth[to, 1];
                FOR al: ArgList _ cat.kittens, al.rest WHILE al # NIL DO
                    WriteNodeExpression[to, al.first];
                    IF al.rest # NIL THEN to.PutRope[","];
                    TS.EndNode[to];
                    ENDLOOP;
                to.PutRope["]]]]"];
                TS.ChangeDepth[to, -1];
                };
            ENDCASE => ERROR;
        };

    WriteInitializer: PUBLIC PROC [job: Job, name: ROPE, cc: CedarChildren, cellDef: CellDef] =
        BEGIN
        dest: TiogaFileOps.Ref;
        opend: ROPE _ NIL;
        AddOpen: PROC [open: ROPE] =
            {opend _ IF opend # NIL THEN opend.Cat[", ", open] ELSE open};
        hasSimple: BOOL _ AuxKnown[name, cellDef, SimpleIO, Ref];
        hasSwitch: BOOL _ AuxKnown[name, cellDef, SwitchIO, Ref];
        hasDrive: BOOL _ AuxKnown[name, cellDef, Drive, Ref];
        TS.EndNode[job.to];
        job.to.PutF["Initialize%g: Initializer = {", IO.rope[name]];
        TS.ChangeDepth[job.to, 1];
        IF cellDef.forFn # NIL THEN {
            job.to.PutF["args: REF %gArgs _ NARROW [cell.type.typeData];", IO.rope[name]];
            TS.ChangeDepth[job.to, 1];
            job.to.PutRope["{OPEN args;"];
            TS.EndNode[job.to];
            };
        IF cellDef.initializerSource # NIL THEN {
            IF hasDrive THEN {
                job.to.PutF["drive: %g _ NARROW[cell.realCellStuff.newDriveAsAny];", IO.rope[GetAux[name, cellDef, Drive, Ref]]];
                TS.EndNode[job.to];
                AddOpen["drive"];
                };
            IF hasSwitch THEN {
                job.to.PutF["sw: %g _ NARROW[cell.realCellStuff.switchIO];", IO.rope[GetAux[name, cellDef, SwitchIO, Ref]]];
                TS.EndNode[job.to];
                IF NOT hasSimple THEN AddOpen["sw"];
                };
            IF hasSimple THEN {
                job.to.PutF["newIO: %g _ NARROW[cell.realCellStuff.newIO];", IO.rope[GetAux[name, cellDef, SimpleIO, Ref]]];
                TS.EndNode[job.to];
                AddOpen["newIO"];
                };
            };
        IF AuxKnown[name, cellDef, State, Ref] AND AuxKnown[name, cellDef, State, Val] THEN
            BEGIN
            job.to.PutF["state: %g _ %g;",
                IO.rope[GetAux[name, cellDef, State, Ref]],
                IO.rope[GetAux[name, cellDef, State, Val]]];
            TS.EndNode[job.to];
            job.to.PutRope["cell.realCellStuff.state _ state;"];
            TS.EndNode[job.to];
            IF cellDef.initializerSource # NIL THEN AddOpen["state"];
            END;
        IF cellDef.initializerSource # NIL THEN
            BEGIN
            job.to.PutRope["BEGIN"];
            IF opend # NIL THEN job.to.PutF[" OPEN %g;", IO.rope[opend]];
            dest _ TS.CurOutNode[job.to];
            TS.ChangeDepth[job.to, 1];
            job.to.PutRope["END;"];
            TS.ChangeDepth[job.to, -1];
            TS.CopyChildren[from: cc.parent, to: dest];
            END;
        IF cellDef.forFn # NIL THEN {
            job.to.PutRope["};"];
            TS.ChangeDepth[job.to, -1];
            };
        job.to.PutRope["};"];
        TS.ChangeDepth[job.to, -1];
        END;

    WriteEval: PUBLIC PROC [job: Job, name: ROPE, et: EvalType, cc: CedarChildren, cellDef: CellDef] =
        BEGIN
        opend: ROPE _ NIL;
        AddOpen: PROC [o: ROPE] = {
            opend _ IF opend = NIL THEN o ELSE (opend.Cat[", ", o])};
        dest: TiogaFileOps.Ref;
        hasSimple: BOOL _ AuxKnown[name, cellDef, SimpleIO, Ref];
        hasSwitch: BOOL _ AuxKnown[name, cellDef, SwitchIO, Ref];
        hasDrive: BOOL _ AuxKnown[name, cellDef, Drive, Ref];
        TS.EndNode[job.to];
        job.to.PutF["%g%g: %g =",
            IO.rope[name],
            IO.rope[etNames[et]],
            IO.rope[SELECT et FROM
                InitQ, PropQ, InitUD, PropUD, FinalUD => "CellProc",
                ValsChanged, EvalSimple => "SimpleEval",
                EnumerateVicinity => "PROC [cell: Cell, portIndex: PortIndex, evenIfInput: BOOL _ FALSE, consume: PROC [PortIndex]]",
                ENDCASE => ERROR]
            ];
        TS.ChangeDepth[job.to, 1];
        job.to.PutRope["BEGIN"]; TS.EndNode[job.to];
        SELECT et FROM
            EnumerateVicinity => NULL;
            InitQ, PropQ, InitUD, PropUD, FinalUD, ValsChanged => {
                IF hasSwitch THEN AddOpen["sw"];
                IF et = ValsChanged AND hasDrive THEN AddOpen["drive"];
                IF cellDef.interfaceLiteral # NIL AND NOT cellDef.interfaceLiteral.hasSwitchElt THEN Whimper[cellDef.sr, job, "Cell class %g has a 
                %g, but no switch-level interface elements!", IO.rope[name], IO.rope[etNames[et]]];
                };
            EvalSimple => {
                IF hasDrive THEN AddOpen["drive"];
                IF hasSimple THEN AddOpen["newIO"];
                };
            ENDCASE => ERROR;
        IF cellDef.forFn # NIL THEN {
            job.to.PutF["args: REF %gArgs _ NARROW[cell.type.typeData];", IO.rope[name]];
            TS.EndNode[job.to];
            AddOpen["args"];
            };
        IF hasDrive THEN {
            job.to.PutF["drive: %g _ NARROW[cell.realCellStuff.newDriveAsAny];", IO.rope[GetAux[name, cellDef, Drive, Ref]]];
            TS.EndNode[job.to];
            };
        IF hasSwitch THEN {
            job.to.PutF["sw: %g _ NARROW[cell.realCellStuff.switchIO];", IO.rope[GetAux[name, cellDef, SwitchIO, Ref]]];
            TS.EndNode[job.to];
            };
        IF hasSimple THEN job.to.PutF["newIO: %g _ NARROW[cell.realCellStuff.newIO];", IO.rope[GetAux[name, cellDef, SimpleIO, Ref]] ];
        IF AuxKnown[name, cellDef, State, Ref] THEN
            BEGIN
            TS.EndNode[job.to];
            job.to.PutF["state: %g _ NARROW[cell.realCellStuff.state];", IO.rope[GetAux[name, cellDef, State, Ref]]];
            AddOpen["state"];
            END;
        TS.ChangeDepth[job.to, 1];
        job.to.PutRope["BEGIN"];
        IF opend # NIL THEN job.to.PutF[" OPEN %g;", IO.rope[opend]];
        dest _ TS.CurOutNode[job.to];
        TS.EndNode[job.to];
        job.to.PutRope["END;"];
        TS.ChangeDepth[job.to, -1];
        TS.CopyChildren[from: cc.parent, to: dest];
        job.to.PutRope["END;"];
        TS.ChangeDepth[job.to, -1];
        END;

    END.