
    <<CompareWrite.Mesa>>
<<Last Edited by: Spreitzer, June 17, 1985 8:42:56 pm PDT>>

    DIRECTORY AssertingIO, Basics, CompareDataStructure, CompareOps, Convert, DFUtilities, FS, IO, List, OrderedSymbolTableRef, Rope, 
    ViewerIO;

    CompareWrite: CEDAR PROGRAM
        IMPORTS AssertingIO, CompareDataStructure, CompareOps, Convert, FS, IO, OrderedSymbolTableRef, Rope =

        BEGIN OPEN CompareDataStructure, CompareOps;

        WriteDesign: PROC [design: Design, root, sub, directory: ROPE] = {
            dfName: ROPE _ root.Cat["-Str.DF"];
            dfOut: IO.STREAM _ FS.StreamOpen[sub.Cat[">", dfName], create];
            count: NAT _ 0;
            NameAndOpen: PROC [cellTypeName: ROPE] RETURNS [fileName: ROPE, stream: IO.STREAM] = {
                stream _ NIL;
                fileName _ cellTypeName.Cat[".sch"];
                stream _ FS.StreamOpen[sub.Cat[">", fileName], create !FS.Error => CONTINUE];
                IF stream # NIL THEN RETURN;
                fileName _ IO.PutFR["%g-%g.sch", IO.rope[root], IO.card[count _ count+1]];
                stream _ FS.StreamOpen[sub.Cat[">", fileName], create];
                };
            PerCellType: PROC [ra: REF ANY] RETURNS [quit: BOOL] = {
                ct: CellType _ NARROW[ra];
                cellFileName: ROPE;
                cellOut: IO.STREAM;
                quit _ FALSE;
                [cellFileName, cellOut] _ NameAndOpen[PickAName[ct.names]];
                dfOut.PutF["\n-- (CellType %g)\n  %g\n", IO.rope[NameStuff[ct.names]], IO.rope[cellFileName]];
                cellOut.PutF["(CellTypeName %g)\n", IO.rope[NameStuff[ct.names]]]; 
                IF (ct.equivClass # implicitClass) THEN cellOut.PutF["(EC %g \"Structure\")\n", IO.refAny[ct.equivClass]]; 
                AssertingIO.WriteTail[cellOut, ct.otherPublic];
                cellOut.PutRope["\n"];
                EnsurePorts[ct];
                WritePorts[cellOut, ct];
                cellOut.PutRope["(PrivateFollows)\n"];
                EnsureParts[ct];
                IF NOT ExpansionKnown[ct]
                    THEN cellOut.PutRope["(InsidesUnspecified)\n"]
                ELSE SELECT GetInternalStyle[ct] FROM
                    graph => {
                        WriteNets[cellOut, ct];
                        WritePortNets[cellOut, ct];
                        WriteComponents[cellOut, ct];
                        };
                    array => WriteArray[cellOut, ct];
                    ENDCASE => ERROR;
                AssertingIO.WriteTail[cellOut, ct.otherPrivate];
                cellOut.PutRope["\n"];
                cellOut.Close[];
                };
            dfOut.PutF["-- %g written by CompareWrite at %g\n", IO.rope[dfName], IO.time[]];
            FOR al: Assertions _ design.other, al.rest WHILE al # NIL DO
                dfOut.PutRope["-- "];
                AssertingIO.WriteAssn[dfOut, al.first];
                dfOut.PutRope["\n"];
                ENDLOOP;
            AssertingIO.WriteTail[dfOut, design.other];
            dfOut.PutRope["\n"];
            dfOut.PutF["\nExports %g%g>\n  %g\n", IO.rope[directory], IO.rope[sub], IO.rope[dfName]];
            design.cellTypesByAddress.EnumerateIncreasing[PerCellType];
            dfOut.Close[];
            };

        WritePorts: PROC [to: IO.STREAM, ct: CellType] = {
            to.PutRope["(Ports"];
            FOR pi: NAT IN [0 .. ct.ports.length) DO
                to.PutF["\n\t(%g", IO.rope[NameStuff[ct.ports[pi].names]]];
                IF ct.ports[pi].equivClass # implicitClass THEN to.PutF[" (EC %g \"Structure\")", IO.refAny[ct.ports[pi].equivClass]];
                AssertingIO.WriteTail[to, ct.ports[pi].other];
                to.PutRope[")"];
                ENDLOOP;
            to.PutRope[")\n"];
            };

        WritePortNets: PROC [to: IO.STREAM, ct: CellType] = {
            FOR pi: NAT IN [0 .. ct.ports.length) DO
                aName: ROPE _ PickAName[ct.ports[pi].names];
                FOR nnl: RopeList _ ct.ports[pi].netNames, nnl.rest WHILE nnl # NIL DO
                    to.PutF["(PN %g %g)\n", IO.refAny[aName], IO.refAny[nnl.first]];
                    ENDLOOP;
                ENDLOOP;
            };

        WriteNets: PROC [to: IO.STREAM, ct: CellType] = {
            PerPart: PROC [asAny: REF ANY] RETURNS [stop: BOOL] = {
                a: Alias _ NARROW[asAny];
                v: Vertex _ NARROW[a.thing];
                stop _ FALSE;
                IF PickAName[v.names] # a.name THEN RETURN;
                SELECT v.class FROM
                    net => {
                        to.PutF["(N %g", IO.rope[NameStuff[v.names]]];
                        AssertingIO.WriteTail[to, v.other];
                        to.PutRope[")\n"];
                        };
                    cell => NULL;
                    ENDCASE => ERROR;
                };
            ct.parts.EnumerateIncreasing[PerPart];
            };

        WriteComponents: PROC [to: IO.STREAM, ct: CellType] = {
            PerPart: PROC [asAny: REF ANY] RETURNS [stop: BOOL] = {
                a: Alias _ NARROW[asAny];
                v: Vertex _ NARROW[a.thing];
                stop _ FALSE;
                IF PickAName[v.names] # a.name THEN RETURN;
                <<AM1 tells us we don't have to worry about this being the mirror.>>
                SELECT v.class FROM
                    net => NULL;
                    cell => {
                        WriteEC: PROC [item: REF ANY] RETURNS [stop: BOOL] = {
                            ec: ExtraConnection _ NARROW[item];
                            stop _ FALSE;
                            to.PutF["\n\t(%g %g)",
                                IO.refAny[PickAName[ec.childNet.names]],
                                IO.refAny[PickAName[ec.parentNet.names]]];
                            };
                        e: Edge _ v.firstEdge;
                        nameFirst, nameRest: ROPE;
                        [nameFirst, nameRest] _ NameParts[v.names];
                        to.PutF["(CI %g %g%g", IO.rope[nameFirst], IO.refAny[PickAName[v.type.names]], IO.rope[nameRest]];
                        AssertingIO.WriteTail[to, v.other];
                        to.PutRope[" (CIC"];
                        FOR pi: NAT IN [0 .. v.type.ports.length) DO
                            IF e.sides[cell].v # v THEN ERROR;
                            IF e.portIndex # pi THEN ERROR;
                            to.PutF["\n\t(%g %g)", IO.refAny[PickAName[v.type.ports[pi].names]], IO.refAny[PickAName[e.sides[net].v.names]]];
                            e _ e.sides[cell].next;
                            ENDLOOP;
                        IF e # NIL THEN ERROR;
                        IF v.extraConnections # NIL THEN v.extraConnections.EnumerateIncreasing[WriteEC];
                        to.PutRope["))\n"];
                        };
                    ENDCASE => ERROR;
                };
            ct.parts.EnumerateIncreasing[PerPart];
            };

        WriteArray: PROC [to: IO.STREAM, ct: CellType] = {
            a: Array _ ct.asArray;
            to.PutF["(Array %g ((%g %g) (%g %g))",
                IO.refAny[PickAName[a.eltType.names]],
                IO.int[a.shape[Foo].min],
                IO.int[a.shape[Foo].maxPlusOne-1],
                IO.int[a.shape[Bar].min],
                IO.int[a.shape[Bar].maxPlusOne-1]];
            FOR dim: Dim IN Dim DO
                FOR perp: EO IN EO DO
                    FOR para: EO IN EO DO
                        j: Joint _ a.joints[dim][perp][para];
                        IF j # NIL THEN {
                            to.PutF["\n\t(J %g %g %g (", IO.rope[DimName[dim]], IO.rope[EOName[perp]], IO.rope[EOName[para]]];
                            FOR lpi: PortIndex IN [0 .. a.eltType.ports.length) DO
                                hpi: PortIndex _ j[lpi].high;
                                IF hpi = NullPortIndex THEN LOOP;
                                IF j[hpi].low # lpi THEN ERROR;
                                to.PutF["\n\t\t(%g %g)",
                                    IO.refAny[PickAName[a.eltType.ports[lpi].names]],
                                    IO.refAny[PickAName[a.eltType.ports[hpi].names]]];
                                ENDLOOP;
                            to.PutRope["))"];
                            };
                        ENDLOOP;
                    ENDLOOP;
                ENDLOOP;
            FOR pi: PortIndex IN [0 .. a.eltType.ports.length) DO
                p: Porting _ a.porting[pi];
                SELECT p FROM
                    notPorted => NULL;
                    unknownPorting => ERROR;
                    ENDCASE => WITH p SELECT FROM
                        dp: DetailedPorting => {
                            to.PutF["\n\t(AP %g", IO.refAny[PickAName[a.eltType.ports[pi].names]]];
                            FOR f: End IN End DO FOR b: End IN End DO
                                IF dp.corners[f][b] # NullPortIndex THEN to.PutF["\n\t\t(C %g %g %g)", IO.rope[EndName[f]], IO.rope[EndName[b]], 
                                IO.refAny[PickAName[ct.ports[dp.corners[f][b]].names]]];
                                ENDLOOP ENDLOOP;
                            FOR e: End IN End DO FOR d: Dim IN Dim DO
                                od: Dim _ OtherDim[d];
                                inners: NAT _ MAX[a.shape[od].maxPlusOne - a.shape[od].min, 2] - 2;
                                Say: PROC [pi: PortIndex] RETURNS [saying: ROPE] = {
                                    saying _ IF pi = NullPortIndex THEN "NC" ELSE Convert.RopeFromRope[PickAName[ct.ports[pi].names]];
                                    };
                                IF inners > 0 THEN {
                                    to.PutF["\n\t\t(S %g %g", IO.rope[EndName[e]], IO.rope[DimName[d]]];
                                    SELECT dp.sideIndices[e][d].same FROM
                                        TRUE => to.PutF[" (S %g))", IO.rope[Say[dp.slots[dp.sideIndices[e][d].firstSlot]]]];
                                        FALSE => {
                                            to.PutRope[" (V"];
                                            FOR i: NAT IN [0 .. inners) DO
                                                to.PutChar[' ];
                                                to.PutRope[Say[dp.slots[dp.sideIndices[e][d].firstSlot+i]]];
                                                ENDLOOP;
                                            to.PutRope["))"];
                                            };
                                        ENDCASE => ERROR;
                                    };
                                ENDLOOP ENDLOOP;
                            to.PutRope[")"];
                            };
                        ENDCASE => ERROR;
                ENDLOOP;
            to.PutRope[")\n"];
            };

        NameStuff: PROC [names: Names] RETURNS [stuff: ROPE] = {
            nameFirst, nameRest: ROPE;
            [nameFirst, nameRest] _ NameParts[names];
            stuff _ nameFirst.Concat[nameRest]};

        NameParts: PROC [names: Names] RETURNS [nameFirst, nameRest: ROPE] = {
            aliasing: BOOL _ FALSE;
            Do: PROC [rl: RopeList, ns: ATOM] = {
                FOR rl _ rl, rl.rest WHILE rl # NIL DO
                    SELECT TRUE FROM
                        nameFirst = NIL => {
                            nameFirst _ IO.PutFR["%g", IO.refAny[rl.first]];
                            IF ns # $U THEN nameRest _ IO.PutFR[" (G %g)", IO.atom[ns]];
                            };
                        nameFirst # NIL => {
                            IF NOT aliasing THEN {
                                nameRest _ nameRest.Cat[" (A"];
                                aliasing _ TRUE};
                            nameRest _ IO.PutFR["%g (%g", IO.rope[nameRest], IO.refAny[rl.first]];
                            IF ns # $U THEN nameRest _ IO.PutFR["%g (G %g)", IO.rope[nameRest], IO.atom[ns]];
                            nameRest _ nameRest.Cat[")"];
                            };
                        ENDCASE => ERROR;
                    ENDLOOP;
                };
            nameFirst _ nameRest _ NIL;
            Do[names.designed, $D];
            Do[names.unknown, $U];
            Do[names.progged, $P];
            IF nameFirst = NIL THEN ERROR;
            IF aliasing THEN nameRest _ nameRest.Cat[")"];
            };

        <<NameParts: PROC [names: Names] RETURNS [nameFirst, nameRest: ROPE] = {>>
            <<Do: PROC [rl: RopeList, ns: ATOM] = {>>
                <<FOR rl _ rl, rl.rest WHILE rl # NIL DO>>
                    <<SELECT TRUE FROM>>
                        <<nameFirst = NIL => {>>
                            <<nameFirst _ IO.PutFR["%g", IO.refAny[rl.first]];>>
                            <<IF ns # $U THEN nameRest _ IO.PutFR[" (G %g)", IO.atom[ns]];>>
                            <<};>>
                        <<nameFirst # NIL => {>>
                            <<nameRest _ IO.PutFR["%g (A %g", IO.rope[nameRest], IO.refAny[rl.first]];>>
                            <<IF ns # $U THEN nameRest _ IO.PutFR["%g (G %g)", IO.rope[nameRest], IO.atom[ns]];>>
                            <<nameRest _ nameRest.Cat[")"];>>
                            <<};>>
                        <<ENDCASE => ERROR;>>
                    <<ENDLOOP;>>
                <<};>>
            <<nameFirst _ nameRest _ NIL;>>
            <<Do[names.designed, $D];>>
            <<Do[names.unknown, $U];>>
            <<Do[names.progged, $P];>>
            <<IF nameFirst = NIL THEN ERROR;>>
            <<};>>

        END.