
<<[Indigo]<Rosemary>Ž>Rosemary.DF=>RoseCreateImplB.Mesa>>
<<Last Edited by: Spreitzer, May 2, 1985 12:51:29 pm PDT>>

    DIRECTORY Asserting, Basics, IO, OrderedSymbolTableRef, PrincOps, Rope, RoseCreate, RoseEvents, RoseTypes;

    RoseCreateImplB: CEDAR PROGRAM
        IMPORTS Asserting, IO, OSTR: OrderedSymbolTableRef, Rope, RoseCreate, RoseEvents, RoseTypes
        EXPORTS RoseCreate =

    BEGIN OPEN RoseCreate, RoseTypes;

    cellTypes: SymbolTable _ OSTR.CreateTable[CompareCellTypes];

    RegisterCellType: PUBLIC PROC
        [
            incrementally: BOOL _ FALSE,
            <<Identification:>>
                name: ROPE,
            <<Structure:>>
                expandProc: ExpandProc _ NIL,
            <<Behavior:>>
                ioCreator: IOCreator _ NIL,
                driveCreator: DriveCreator _ NIL,
                initializer: Initializer _ NIL,
                evals: EvalProcs _ [],
                tests: CellTestList _ NIL,
            <<Other:>>
                ports: Ports,
                typeData: REF ANY _ NIL,
                other: Assertions _ NIL
            ]
        RETURNS [type: CellType] =
        BEGIN
        replace: BOOL = NOT incrementally;
        conformingInterface, equalInterface: BOOL _ FALSE;
        oldHadBehavior: BOOL _ FALSE;
        newHasBehavior: BOOL _ evals.EvalSimple # NIL OR evals.PropUD # NIL;
        simpleWordCount, switchWordCount: CARDINAL _ 0;
        hasASwitchPort: BOOL _ FALSE;
        FOR portIndex: PortIndex IN [0 .. ports.length) DO
            port: Port _ ports[portIndex];
            simpleWordCount _ MAX[simpleWordCount, MinSize[port.simple]];
            switchWordCount _ MAX[switchWordCount, MinSize[port.switch]];
            IF port.type = NIL THEN ERROR Error[IO.PutFR["No NodeType given for Port %g", IO.rope[port.name]]];
            IF NOT port.type.simple THEN hasASwitchPort _ TRUE;
            ENDLOOP;
        type _ NARROW[cellTypes.Lookup[name]];
        IF type = NIL THEN {
            type _ NEW [CellTypeRep _ [name: name, testers: OSTR.CreateTable[CompareTests]]];
            cellTypes.Insert[type];
            }
        ELSE {
            [conformingInterface, equalInterface] _ EqualInterfaces[ports, type.ports];
            oldHadBehavior _ type.evals.EvalSimple # NIL OR type.evals.PropUD # NIL;
            };
        IF type.firstInstance # NIL THEN {
            firstLeaf: BOOL _ TRUE;
            IF NOT incrementally THEN ERROR Error["Can't forget about instances", type];
            IF NOT conformingInterface THEN ERROR Error["Can't change interface structure of existing instances", type];
            FOR instance: Cell _ type.firstInstance, instance.nextInstance WHILE instance # NIL DO
                IF instance.type # type THEN ERROR;
                IF instance.expansion = Leaf THEN {
                    IF firstLeaf THEN {
                        firstLeaf _ FALSE;
                        IF NOT oldHadBehavior THEN ERROR;
                        IF NOT newHasBehavior THEN ERROR Error["Can't relieve existing instances of behavior", type];
                        IF NOT equalInterface THEN ERROR Error["Can't change interface of existing instances", type];
                        };
                    IF instance.realCellStuff.evals # type.evals THEN ERROR;
                    instance.realCellStuff.evals _ evals;
                    };
                ENDLOOP;
            };
        type.ports _ ports;
        IF NOT equalInterface THEN {
            type.simpleWordCount _ simpleWordCount;
            type.switchWordCount _ switchWordCount;
            type.hasASwitchPort _ hasASwitchPort;
            };
        IF replace OR expandProc # NIL THEN type.expand _ expandProc;
        IF replace OR ioCreator # NIL THEN type.ioCreator _ ioCreator;
        IF replace OR driveCreator # NIL THEN type.driveCreator _ driveCreator;
        IF replace OR initializer # NIL THEN type.initializer _ initializer;
        IF replace OR evals # [] THEN type.evals _ evals;
        IF replace OR typeData # NIL THEN type.typeData _ typeData;
        IF incrementally
            THEN type.other _ Asserting.Union[other, type.other]
            ELSE type.other _ other;
        IF NOT incrementally THEN type.testers.DeleteAllItems[];
        FOR tests _ tests, tests.rest WHILE tests # NIL DO
            [] _ SetTest[test: NEW [CellTestRep _ tests.first], of: type, mayOverwriteOld: incrementally];
            ENDLOOP;
        END;

    GetCellType: PUBLIC PROC [name: ROPE] RETURNS [type: CellType] =
        {type _ NARROW[cellTypes.Lookup[name]]};

    GetTest: PUBLIC PROC [name: ROPE, from: CellType] RETURNS [t: CellTest] =
        {t _ NARROW[from.testers.Lookup[name]]};

    SetTest: PUBLIC PROC [test: CellTest, of: CellType, mayOverwriteOld: BOOL _ FALSE] RETURNS [old: CellTest] = {
        old _ NARROW[of.testers.Lookup[test]];
        IF old # NIL THEN {
            IF mayOverwriteOld
                THEN {IF of.testers.Delete[test] # old THEN ERROR}
                ELSE ERROR Error[IO.PutFR["Duplicate Test (named %g) given for cell type %g", IO.rope[test.name], IO.rope[of.name]]];
            };
        of.testers.Insert[test];
        };

    EqualInterfaces: PUBLIC PROC [a, b: Ports] RETURNS [structurally, fully: BOOL] = {
        structurally _ fully _ a.length = b.length;
        FOR portIndex: PortIndex IN [0 .. a.length) WHILE structurally DO
            IF NOT (
                Conforming[a[portIndex].type, b[portIndex].type] AND
                a[portIndex].input = b[portIndex].input AND
                a[portIndex].output = b[portIndex].output AND
                a[portIndex].name.Equal[b[portIndex].name]
                )
            THEN structurally _ fully _ FALSE;
            IF NOT (
                FieldEqual[a[portIndex].simple, b[portIndex].simple] AND
                FieldEqual[a[portIndex].switch, b[portIndex].switch] AND
                a[portIndex].type = b[portIndex].type AND
                a[portIndex].XPhobic = b[portIndex].XPhobic
                )
            THEN fully _ FALSE;
            ENDLOOP;
        };

    CreateSim: PUBLIC PROC [steady: BOOL] RETURNS [sim: Simulation] = {
        sim _ NEW [SimulationRep _ [steady: steady]];
        RoseEvents.Notify[event: $NewSim, handleAborted: TRUE, arg: sim];
        };

    Possible: PUBLIC PROC [cell: Cell, whatToDo: ExpandDecision] RETURNS [possible: BOOLEAN] =
        BEGIN
        evalable: BOOL _ cell.type.evals.EvalSimple # NIL OR cell.type.evals.PropUD # NIL;
        iok: BOOL _ (cell.type.simpleWordCount = 0 AND cell.type.switchWordCount = 0) OR cell.type.ioCreator # NIL;
        RETURN [SELECT whatToDo FROM
            Leaf => evalable AND iok,
            Expand => cell.type.expand # NIL,
            ENDCASE => ERROR];
        END;

    XPhobicize: PUBLIC PROC [n: Node] RETURNS [m: Node-- = n --] =
        {(m _ n).XPhobic _ TRUE};

    EnumerateConnections: PUBLIC PROC [asRope: ROPE, to: PROC [key: Key, nodeName: ROPE]] = {
        index: CARDINAL _ 0;
        in: IO.STREAM _ IO.RIS[asRope];
        [] _ in.GetIndex[];    --wake up generic GetIndex impl
        FOR i: NAT _ in.SkipWhitespace[], in.SkipWhitespace[] WHILE NOT in.EndOf[] DO
            nodeName: ROPE _ GetName[in];
            [] _ in.SkipWhitespace[];
            IF (NOT in.EndOf[]) AND (in.PeekChar[] = ':) THEN {
                portName: ROPE _ nodeName;
                IF in.GetChar[] # ': THEN ERROR;
                [] _ in.SkipWhitespace[];
                IF in.EndOf[] THEN ERROR Error[IO.PutFR["Interface spec syntax error, at %g", IO.int[in.GetIndex[]]]];
                nodeName _ GetName[in];
                to[[keyword[portName]], nodeName];
                }
            ELSE {
                to[[position[index]], nodeName];
                };
            index _ index + 1;
            [] _ in.SkipWhitespace[];
            IF in.EndOf[] THEN EXIT;
            IF in.GetChar[] # ', THEN ERROR Error[IO.PutFR["Interface spec syntax error (missing comma?), at %g", IO.int[in.GetIndex[]]]];
            ENDLOOP;
        in.Close[];
        };

    FillInInterfaceNodes: PUBLIC PROC [cell: Cell, interfaceNodes: ROPE] =
        BEGIN
        PerConnection: PROC [key: Key, nodeName: ROPE] = {
            portName: ROPE;
            portIndex: PortIndex;
            WITH key SELECT FROM
                x: Key.position => {
                    IF x.index >= cell.interfaceNodes.length THEN ERROR Error[IO.PutFR["No %g'th element in %g's Interface", IO.int[x.index], 
                    IO.rope[cell.type.name]]];
                    portName _ cell.type.ports[portIndex _ x.index].name;
                    };
                x: Key.keyword => {
                    IF (portIndex _ GetIndex[cell.type.ports, portName _ x.name]) = notFound THEN ERROR Error[IO.PutFR["No such port (%g) for CellType 
                    %g", IO.rope[portName], IO.rope[cell.type.name]]];
                    };
                ENDCASE => ERROR;
            IF cell.interfaceNodes[portIndex] # NIL THEN ERROR Error[IO.PutFR["Port %g specified twice in \"%g\"", IO.rope[portName], 
            IO.rope[interfaceNodes]]];
            cell.interfaceNodes[portIndex] _ LookupCellNode[cell.parent, nodeName];
            IF cell.interfaceNodes[portIndex] = NIL THEN ERROR Error[IO.PutFR["Node %g not found", IO.rope[nodeName]]];
            IF NOT Conforming[cell.interfaceNodes[portIndex].type, cell.type.ports[portIndex].type] THEN ERROR InterfaceMismatch[
                cell: cell,
                index: portIndex,
                expected: cell.type.ports[portIndex].type,
                got: cell.interfaceNodes[portIndex].type];
            };
        EnumerateConnections[interfaceNodes, PerConnection];
        FOR portIndex: PortIndex IN [0 .. cell.interfaceNodes.length) DO
            IF cell.interfaceNodes[portIndex] = NIL THEN
                BEGIN
                nodeName: ROPE _ cell.type.ports[portIndex].name;
                cell.interfaceNodes[portIndex] _ LookupCellNode[cell.parent, nodeName];
                IF cell.interfaceNodes[portIndex] = NIL THEN ERROR Error[IO.PutFR["Port %g not specified in \"%g\"", IO.rope[nodeName], 
                IO.rope[interfaceNodes]]];
                END;
            ENDLOOP;
        END;

    GetName: PROC [from: IO.STREAM] RETURNS [name: ROPE] = {
        first: CHAR _ from.PeekChar[];
        SELECT first FROM
            '" => name _ from.GetRopeLiteral[];
            ENDCASE => name _ from.GetTokenRope[IDBreak].token;
        };

    IDBreak: IO.BreakProc =
        {RETURN [SELECT char FROM
            IO.SP, IO.CR, IO.LF, IO.TAB => sepr,
            ',, ': => break,
            ENDCASE => other]};

    MinSize: PROC [f: Field] RETURNS [words: CARDINAL] = {
        words _ f.wordOffset + (INTEGER[f.bitOffset] + f.bitCount + Basics.bitsPerWord - 1)/Basics.bitsPerWord;
        };

    FieldEqual: PROC [f1, f2: Field] RETURNS [eq: BOOL] =
        {eq _ f1 = f2};

    CompareRopes: PUBLIC PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
        BEGIN
        ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
            {RETURN [WITH ref SELECT FROM r: ROPE => r, ENDCASE => ERROR]};
        RETURN [ToKey[r1].Compare[ToKey[r2]]];
        END;

    CompareComponents: PUBLIC PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
        BEGIN
        ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
            {RETURN [WITH ref SELECT FROM
                r: ROPE => r, c: Cell => c.name, ENDCASE => ERROR]};
        RETURN [ToKey[r1].Compare[ToKey[r2]]];
        END;

    CompareNodes: PUBLIC PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
        BEGIN
        k1, k2: ROPE;
        WITH r1 SELECT FROM
            r: ROPE => k1 _ r;
            n: Node => k1 _ n.name;
            ENDCASE => ERROR;
        k2 _ WITH r2 SELECT FROM
            r: ROPE => r,
            n: Node => n.name,
            ENDCASE => ERROR;
        RETURN [k1.Compare[k2]];
        END;

    CompareCellTypes: PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
        BEGIN
        ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
            {RETURN [WITH ref SELECT FROM
                r: ROPE => r, ct: CellType => ct.name, ENDCASE => ERROR]};
        RETURN [ToKey[r1].Compare[ToKey[r2]]];
        END;

    CompareTests: PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
        BEGIN
        ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
            {RETURN [WITH ref SELECT FROM
                r: ROPE => r, a: CellTest => a.name, ENDCASE => ERROR]};
        RETURN [ToKey[r1].Compare[ToKey[r2]]];
        END;

    END.