
    <<CoreFlatImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Barth, May 1, 1986 3:52:25 pm PDT>>
        <<Spreitzer, April 8, 1986 4:31:47 pm PST>>
        <<Last Edited by: Neil Gunther May 8, 1986 6:12:55 pm PDT>>
        <<Bertrand Serlet May 16, 1986 11:28:14 am PDT>>
        <<>>
    DIRECTORY Basics, BitHacks, Convert, Core, CoreClasses, CoreFlat, CoreOps, HashTable, IO, Rope;

    CoreFlatImpl: CEDAR PROGRAM
        IMPORTS Basics, BitHacks, Convert, CoreClasses, CoreOps, HashTable, IO, Rope
        EXPORTS CoreFlat
        = BEGIN OPEN CoreFlat;

    PathError: PUBLIC ERROR [msg: ROPE _ NIL] = CODE;
<<Flatten>>
    GetCellType: PUBLIC PROC [root: Core.CellType, path: PackedPath] RETURNS [cellType: Core.CellType _ NIL] = {

        SetCellType: EachUnboundInstanceProc = {
            innerCellType _ CoreOps.ToBasic[instance.instance.type]
            };

        innerCellType: Core.CellType _ root;
        VisitUnboundPath[root, path, SetCellType];
        cellType _ innerCellType;
        };

    VisitUnboundPath: PUBLIC PROC [root: Core.CellType, path: PackedPath, eachInstance: EachUnboundInstanceProc] = {
        currentPath: PackedPath _ NullPath;
        UNTIL currentPath.length=path.length DO
            cellType: Core.CellType _ CoreOps.ToBasic[root];
            rct: CoreClasses.RecordCellType _ NARROW [cellType.data];
            pathBits: NAT _ BitHacks.NBits[rct.size];
            instanceBits: PACKED ARRAY [0..16) OF BOOL _ ALL [FALSE];
            instance: CoreClasses.CellInstance;
            oldPath: PackedPath _ currentPath;
            FOR bit: NAT IN [0..pathBits) DO
                instanceBits[16-pathBits+bit] _ path.bits[currentPath.length+bit];
                currentPath.bits[currentPath.length+bit] _ path.bits[currentPath.length+bit];
                ENDLOOP;
            currentPath.length _ currentPath.length+pathBits;
            instance _ rct[LOOPHOLE[instanceBits]];
            root _ instance.type;
            eachInstance[[oldPath, instance], cellType];
            ENDLOOP;
        };

    BoundCellType: PUBLIC PROC [root: Core.CellType, path: PackedPath] RETURNS [bindings: HashTable.Table, cellType: Core.CellType] = {

        SetInnerCellType: EachBoundInstanceProc = {
            innerCellType _ cellType;
            };

        innerCellType: Core.CellType _ root;
        bindings _ VisitBoundPath[root, path, SetInnerCellType];
        cellType _ innerCellType;
        };

    VisitBoundPath: PUBLIC PROC [root: Core.CellType, path: PackedPath, eachInstance: EachBoundInstanceProc] RETURNS [bindings: 
    HashTable.Table] = {

        BindCellTypeAndInstance: EachUnboundInstanceProc = {
            BindInternal[bindings, instance.path, cellType];
            [bindings, innerCellType] _ BindInstance[instance.instance, bindings];
            eachInstance[bindings, instance, cellType];
            };

        innerCellType: Core.CellType;
        [bindings, innerCellType] _ InitializeBindings[root];
        VisitUnboundPath[root, path, BindCellTypeAndInstance];
        BindInternal[bindings, path, innerCellType];
        };

    EnumerateLeaves: PUBLIC PROC [root: Core.CellType, eachInstance: EachInstanceProc, rootCellType, beforeInstances, afterInstances: 
    EachCellTypeProc _ NIL] = {

        VisitCellType: PROC [bindings: HashTable.Table, path: PackedPath, parent: Core.CellType] = {
            parentRCT: CoreClasses.RecordCellType _ NARROW[parent.data];
            pathBits: NAT _ BitHacks.NBits[parentRCT.size];
            BindInternal[bindings, path, parent];
            IF beforeInstances#NIL THEN beforeInstances[bindings, path, parent];
            FOR in: NAT IN [0..parentRCT.size) DO
                instance: CoreClasses.CellInstance _ parentRCT[in];
                IF eachInstance[bindings, path, instance] THEN {
                    newBindings: HashTable.Table;
                    child: Core.CellType;
                    [newBindings, child] _ BindInstance[instance, bindings];
                    VisitCellType[newBindings, ExtendPath[path, in, pathBits], child];
                    };
                ENDLOOP;
            IF afterInstances#NIL THEN afterInstances[bindings, path, parent];
            };

        bindings: HashTable.Table;
        path: PackedPath _ NullPath;
        rootRCT: Core.CellType;
        [bindings, rootRCT] _ InitializeBindings[root];
        IF rootCellType#NIL THEN rootCellType[bindings, path, rootRCT];
        VisitCellType[bindings, path, rootRCT];
        };
            <<>>
    EnumerateAtomicWireLeaves: PUBLIC PROC [root: Core.CellType, rootWire: Core.Wire, eachInternalWire: EachInternalWireProc _ NIL, 
    eachWireInstance: EachWireInstanceProc _ NIL] = {

        FilterWire: EachCellTypeProc = {

            FindWire: CoreOps.EachWireProc = {
                bind: WireBind;
                IF wire.size#0 THEN RETURN;
                bind _ NARROW [HashTable.Fetch[table: bindings, key: wire].value];
                IF (quit _ bind.wire=rootWire) THEN thisWire _ wire;
                };

            IF NOT CoreOps.VisitWire[NARROW [cellType.data, CoreClasses.RecordCellType].internal, FindWire] THEN ERROR;
            IF eachInternalWire#NIL THEN eachInternalWire[bindings: bindings, path: path, cellType: cellType, wire: thisWire]
            };

        FilterInstance: EachInstanceProc = {
            bound: BOOL _ CoreOps.RecursiveMember[wire: instance.actual, candidate: thisWire];
            IF eachWireInstance#NIL AND bound THEN flatten _ eachWireInstance[bindings: bindings, path: path, instance: instance, wire: 
            thisWire] ELSE {
                IF bound THEN {
                    cellType: Core.CellType _ CoreOps.ToBasic[instance.type];
                    flatten _ cellType.class#CoreClasses.transistorCellClass AND cellType.class#CoreClasses.unspecifiedCellClass;
                    }
                ELSE flatten _ FALSE;
                };
            };

        thisWire: Core.Wire;
        IF rootWire.size#0 THEN ERROR;
        EnumerateLeaves[root: root, beforeInstances: FilterWire, eachInstance: FilterInstance];
        };

    InitializeBindings: PROC [root: Core.CellType] RETURNS [bindings: HashTable.Table, rootRCT: Core.CellType] = {

        InsertBindings: CoreOps.EachWireProc = {
            [] _ HashTable.Store[
                table: bindings, key: wire, 
                value: NEW [WireBindRec _ [path: NullPath, wire: wire]]
                ];
            };

        rootRCT _ CoreOps.ToBasic[root];
        bindings _ HashTable.Create[rootRCT.public.size+1];
        FOR i: NAT IN [0..rootRCT.public.size) DO
            IF CoreOps.VisitWire[wire: rootRCT.public[i], eachWire: InsertBindings] THEN ERROR;
            ENDLOOP;
        };
            <<>>
    BindInternal: PROC [bindings: HashTable.Table, path: PackedPath, cellType: Core.CellType] = {

        InsertBindings: CoreOps.EachWireProc = {
            wireBind: WireBind _ NARROW [HashTable.Fetch[table: bindings, key: wire].value];
            IF wireBind=NIL THEN [] _ HashTable.Store[
                table: bindings, key: wire, 
                value: NEW [WireBindRec _ [path: path, wire: wire]]
                ];
            };

        internal: Core.Wire _ NARROW [cellType.data, CoreClasses.RecordCellType].internal;
        FOR i: NAT IN [0..internal.size) DO
            IF CoreOps.VisitWire[wire: internal[i], eachWire: InsertBindings] THEN ERROR;
            ENDLOOP;
        };

    BindInstance: PROC [instance: CoreClasses.CellInstance, bindings: HashTable.Table] RETURNS [newBindings: HashTable.Table, child: 
    Core.CellType] = {

        BindPublicToActual: CoreOps.EachWirePairProc = {
            bind: WireBind _ NARROW [HashTable.Fetch[table: bindings, key: actualWire].value];
            IF bind=NIL THEN ERROR;
            [] _ HashTable.Store[table: newBindings, key: publicWire, value: bind];
            };

        actual: Core.Wire _ instance.actual;
        child _ CoreOps.ToBasic[instance.type];
        newBindings _ HashTable.Create[child.public.size+1];
        FOR i: NAT IN [0..actual.size) DO
            IF CoreOps.VisitBinding[actual: actual[i], public: child.public[i], eachWirePair: BindPublicToActual] THEN ERROR;
            ENDLOOP;
        };

<<Paths>>
    FindPath: PUBLIC PROC [root: Core.CellType, pathRope: ROPE] RETURNS [path: PackedPath] = {
        token: ROPE;
        ts: IO.STREAM;
        firstChar: CHAR;
        tokenKind: IO.TokenKind;
        within: Core.CellType;
        [path, token, ts, firstChar, tokenKind, within] _ ParseFullPath[root, pathRope];
        CheckNoMore[ts, firstChar, tokenKind];
        };

    PathRope: PUBLIC PROC [root: Core.CellType, path: PackedPath] RETURNS [pathRope: ROPE _ NIL] = {

        AppendName: EachUnboundInstanceProc = {
            coreInstance: CoreClasses.CellInstance _ instance.instance;
            name: ROPE _ CoreClasses.GetCellInstanceName[coreInstance];
            IF name=NIL THEN {
                cellTypeName: ROPE _ CoreOps.GetCellTypeName[coreInstance.type];
                name _ Convert.RopeFromInt[InstanceIndex[cellType, coreInstance]];
                IF cellTypeName#NIL THEN name _ Rope.Cat[name, "(", cellTypeName, ")"];
                };
            pathRope _ Rope.Cat[pathRope, "/", name];
            };

        VisitUnboundPath[root, path, AppendName];
        };

    PathEqual: PUBLIC PROC [one: PackedPath, other: PackedPath] RETURNS [equal: BOOL] = {
        oneBits: INT _ LOOPHOLE[one.bits];
        otherBits: INT _ LOOPHOLE[other.bits];
        equal _ one.length=other.length AND oneBits=otherBits;
        <<IF equal THEN FOR bit: NAT IN [0..one.length) DO>>
            <<IF one.bits[bit]#other.bits[bit] THEN {>>
                <<equal _ FALSE;>>
                <<EXIT;>>
                <<};>>
            <<ENDLOOP;>>
        };

    PathHash: PUBLIC PROC [path: PackedPath] RETURNS [hash: CARDINAL] = TRUSTED {
        pathAsLN: Basics.LongNumber _ Basics.SwapHalves[LOOPHOLE[path.bits]];
        pathAsLN _ Basics.DoubleShiftRight[pathAsLN, 32-path.length];
    hash _ Basics.BITXOR[pathAsLN.lowbits, pathAsLN.highbits];
        };

    ComputePackedPath: PUBLIC PROC [root: Core.CellType, instantiationPath: InstantiationPath] RETURNS [path: PackedPath] = {
        path.length _ 0;
        instantiationPath _ CoreClasses.ReverseCellInstances[instantiationPath];
        FOR instPath: InstantiationPath _ instantiationPath, instPath.rest UNTIL instPath=NIL DO
            rc: Core.CellType _ CoreOps.ToBasic[root];
            rct: CoreClasses.RecordCellType _ NARROW[rc.data];
            FOR in: NAT IN [0..rct.size) DO
                IF rct[in]=instPath.first THEN {
                    pathBits: NAT _ BitHacks.NBits[rct.size];
                    path _ ExtendPath[path, in, pathBits];
                    root _ rct[in].type;
                    EXIT;
                    };
                REPEAT
                    FINISHED => ERROR;
                ENDLOOP;
            ENDLOOP;
        };

<<Instances>>
    FindInstance: PUBLIC PROC [root: Core.CellType, instancePathRope: ROPE] RETURNS [instance: FlatInstanceRec] = {
        within: Core.CellType;
        token: ROPE;
        ts: IO.STREAM;
        firstChar: CHAR;
        tokenKind: IO.TokenKind;
        [instance.path, instance.instance, within, token, ts, firstChar, tokenKind] _ ParseInstancePath[root, instancePathRope];
        CheckNoMore[ts, firstChar, tokenKind];
        };

    InstancePathRope: PUBLIC PROC [root: Core.CellType, instance: FlatInstanceRec] RETURNS [instancePathRope: ROPE] = {
        pathWithInstance: PackedPath _ AddInstance[instance.path, instance.instance, GetCellType[root, instance.path]];
        instancePathRope _ PathRope[root, pathWithInstance];
        };

    FlatInstanceEqual: PUBLIC PROC [one, other: REF ANY -- FlatInstance --] RETURNS [equal: BOOL] = {
        equal _ FlatInstanceEqualRec[NARROW[one, FlatInstance]^, NARROW[other, FlatInstance]^];
        };

    FlatInstanceEqualRec: PUBLIC PROC [one, other: FlatInstanceRec] RETURNS [equal: BOOL] = {
    equal _ PathEqual[one.path, other.path] AND one.instance=other.instance;
        };

    FlatInstanceHash: PUBLIC PROC [instance: REF ANY -- FlatInstance --] RETURNS [hash: CARDINAL] = {
        hash _ FlatInstanceHashRec[NARROW[instance, FlatInstance]^];
        };

    FlatInstanceHashRec: PUBLIC PROC [instance: FlatInstanceRec] RETURNS [hash: CARDINAL] = {
    hash _ PathHash[instance.path];
    hash _ Basics.BITXOR[hash, Basics.LowHalf[LOOPHOLE[instance.instance]]];
    hash _ Basics.BITXOR[hash, Basics.HighHalf[LOOPHOLE[instance.instance]]];
        };

<<Wires>>
    FindWire: PUBLIC PROC [root: Core.CellType, wirePathRope: ROPE] RETURNS [wire: FlatWireRec, wireRoot: WireRoot] = {

        AppendNameWire: PROC = {
            state _ sawWireNameOrNumber;
            IF RootWire[]#none THEN MakeError["Cannot name a wire actual, internal, or public"];
            FOR subWire: CARDINAL IN [0..wire.wire.size) DO
                IF Rope.Equal[token, CoreOps.GetShortWireName[wire.wire[subWire]]] THEN {
                    wire.wire _ wire.wire[subWire];
                    EXIT;
                    };
                REPEAT FINISHED => MakeError["Can't find wire"];
                ENDLOOP;
            };

        AppendNumberWire: PROC = {
            parent: Core.Wire _ IF wire.wire=NIL THEN NARROW[CoreOps.ToBasic[within].data, CoreClasses.RecordCellType].internal ELSE wire.wire;
            subWire: CARDINAL _ Convert.CardFromRope[token];
            IF subWire>=parent.size THEN MakeError["No such wire"];
            wire.wire _ parent[subWire];
            };

        PossibleRootWire: PROC = {
            wireType: RootWireType _ RootWire[];
            SELECT wireType FROM
                public => {
                    state _ sawWireRoot;
                    wire.wire _ within.public;
                    wireRoot _ public; 
                    };
                internal => {
                    rct: CoreClasses.RecordCellType _ NARROW[CoreOps.ToBasic[within].data];
                    state _ sawWireRoot;
                    wire.wire _ rct.internal;
                    wireRoot _ internal; 
                    };
                actual => {
                    MakeError["Visiting actual not implemented"];
                    };
                none => {
                    wire.wire _ NARROW[CoreOps.ToBasic[within].data, CoreClasses.RecordCellType].internal;
                    AppendNameWire[];
                    wireRoot _ internal; 
                    };
                ENDCASE => ERROR;
            };

        RootWireType: TYPE = {public, internal, actual, none};

        RootWire: PROC RETURNS [RootWireType] = {
            RETURN [SELECT TRUE FROM
                Rope.Equal[token, "PUBLIC", FALSE] => public,
                Rope.Equal[token, "INTERNAL", FALSE] => internal,
                Rope.Equal[token, "ACTUAL", FALSE] => actual,
                ENDCASE => none];
            };

        <<WirePath ::= {start} ?((PUBLIC | INTERNAL | ACTUAL ) {sawWireRoot} . {expectWireNameOrNumber} )  (( Name | Number ) 
        {sawWireNameOrNumber} ?( . {expectWireNameOrNumber})) | ( [ {sawLeft} Number {sawNumber} ] {sawRight} )>>
        WirePathParseStates: TYPE = {start, expectMaybeRoot, sawWireRoot, expectWireNameOrNumber, sawWireNameOrNumber, sawLeft, sawNumber, 
        sawRight};
        token: ROPE;
        ts: IO.STREAM;
        firstChar: CHAR;
        tokenKind: IO.TokenKind;
        within: Core.CellType;
        state: WirePathParseStates _ start;
        [wire.path, token, ts, firstChar, tokenKind, within] _ ParseFullPath[root, wirePathRope];
        DO
            SELECT state FROM
                start => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        '[ => state _ sawLeft;
                        '. => state _ expectMaybeRoot;
                        ENDCASE => MakeError[];
                    tokenID => PossibleRootWire[];
                    tokenDECIMAL => {AppendNumberWire[]; state _ sawWireNameOrNumber};
                    ENDCASE => MakeError[];
                expectMaybeRoot => SELECT tokenKind FROM
                    tokenID => PossibleRootWire[];
                    tokenDECIMAL => {AppendNumberWire[]; state _ sawWireNameOrNumber};
                    ENDCASE => MakeError[];
                sawWireRoot => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        '. => state _ expectWireNameOrNumber;
                        ENDCASE => MakeError[];
                    ENDCASE => MakeError[];
                expectWireNameOrNumber => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        '[ => state _ sawLeft;
                        ENDCASE => MakeError[];
                    tokenID => AppendNameWire[];
                    tokenDECIMAL => {AppendNumberWire[]; state _ sawWireNameOrNumber};
                    ENDCASE => MakeError[];
                sawWireNameOrNumber => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        '. => state _ expectWireNameOrNumber;
                        '[ => state _ sawLeft;
                        ENDCASE => MakeError[];
                    ENDCASE => MakeError[];
                sawLeft => SELECT tokenKind FROM
                    tokenDECIMAL => {AppendNumberWire[]; state _ sawNumber};
                    ENDCASE => MakeError[];
                sawNumber => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        '] => state _ sawRight;
                        ENDCASE => MakeError[];
                    ENDCASE => MakeError[];
                sawRight => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        '[ => state _ sawLeft;
                        ENDCASE => MakeError[];
                    tokenID => AppendNameWire[];
                    tokenDECIMAL => {AppendNumberWire[]; state _ sawWireNameOrNumber};
                    ENDCASE => MakeError[];
                ENDCASE => MakeError[];
            [token, firstChar, tokenKind] _ ParseToken[ts ! IO.EndOfStream => EXIT];
            ENDLOOP;
        IF state=sawWireRoot OR state=expectWireNameOrNumber OR state=sawLeft OR state=sawNumber THEN MakeError[];
        };

    WirePathRope: PUBLIC PROC [root: Core.CellType, wire: FlatWireRec, wireRoot: WireRoot _ internal] RETURNS [wirePathRope: ROPE] = {
        rootWire: Core.Wire;
        pathRope: ROPE;
        SELECT wireRoot FROM
            public => {

                SetContainerCell: EachUnboundInstanceProc = {
                    containerCell _ instance.instance.type;
                    };

                containerCell: Core.CellType _ root;
                VisitUnboundPath[root, wire.path, SetContainerCell];
                rootWire _ containerCell.public;
                };
            internal => rootWire _ NARROW[CoreOps.ToBasic[GetCellType[root, wire.path]].data, CoreClasses.RecordCellType].internal;
            actual => ERROR;  -- not implemented
            ENDCASE => ERROR;
        pathRope _ PathRope[root, wire.path];
        IF NOT Rope.IsEmpty[pathRope] THEN pathRope _ Rope.Cat[pathRope, "."]; 
        wirePathRope _ Rope.Cat[pathRope, SELECT wireRoot FROM public => "public.", internal => "internal.", actual => "actual.", ENDCASE 
        => ERROR, CoreOps.GetFullWireNames[rootWire, wire.wire].first];
        };

    FlatWireEqual: PUBLIC PROC [one, other: REF ANY -- FlatWire --] RETURNS [equal: BOOL] = {
        equal _ FlatWireEqualRec[NARROW[one, FlatWire]^, NARROW[other, FlatWire]^];
        };

    FlatWireEqualRec: PUBLIC PROC [one, other: FlatWireRec] RETURNS [equal: BOOL] = {
    equal _ PathEqual[one.path, other.path] AND one.wire=other.wire;
        };

    FlatWireHash: PUBLIC PROC [wire: REF ANY -- FlatWire --] RETURNS [hash: CARDINAL] = {
        hash _ FlatWireHashRec[NARROW[wire, FlatWire]^];
        };

    FlatWireHashRec: PUBLIC PROC [wire: FlatWireRec] RETURNS [hash: CARDINAL] = TRUSTED {
    hash _ PathHash[wire.path];
    hash _ Basics.BITXOR[hash, Basics.LowHalf[LOOPHOLE[wire.wire]]];
    hash _ Basics.BITXOR[hash, Basics.HighHalf[LOOPHOLE[wire.wire]]];
        };

<<Utilities>>
    InstanceIndex: PROC [within: Core.CellType, instance: CoreClasses.CellInstance] RETURNS [index: NAT] = {
        withinCT: Core.CellType _ CoreOps.ToBasic[within];
        withinRCT: CoreClasses.RecordCellType _ NARROW[withinCT.data];
        FOR index IN [0..withinRCT.size) DO
            IF withinRCT[index]=instance THEN EXIT;
            REPEAT FINISHED => ERROR;
            ENDLOOP;
        };

    ParseFullPath: PUBLIC PROC [root: Core.CellType, pathRope: ROPE] RETURNS [path: PackedPath, token: ROPE, ts: IO.STREAM, firstChar: 
    CHAR, tokenKind: IO.TokenKind, within: Core.CellType] = {
        instance: CoreClasses.CellInstance;
        [path, instance, within, token, ts, firstChar, tokenKind] _ ParseInstancePath[root, pathRope];
        path _ AddInstance[path, instance, within];
        IF instance#NIL THEN within _ instance.type;
        };

    ParseInstancePath: PROC [root: Core.CellType, pathRope: ROPE] RETURNS [path: PackedPath _ CoreFlat.NullPath, instance: 
    CoreClasses.CellInstance _ NIL, within: Core.CellType, token: ROPE, ts: IO.STREAM, firstChar: CHAR, tokenKind: IO.TokenKind] = {

        AppendNameInstance: PROC = {
            found: BOOL _ FALSE;
            rct: CoreClasses.RecordCellType;
            path _ AddInstance[path, instance, within];
            within _ IF instance=NIL THEN root ELSE instance.type;
            rct _ NARROW[CoreOps.ToBasic[within].data];
            FOR inst: CARDINAL IN [0..rct.size) DO
                IF Rope.Equal[token, CoreClasses.GetCellInstanceName[rct[inst]]] THEN {
                    instance _ rct[inst];
                    found _ TRUE;
                    EXIT;
                    };
                REPEAT FINISHED => FOR inst: CARDINAL IN [0..rct.size) DO
                    IF Rope.Equal[token, CoreOps.GetCellTypeName[rct[inst].type]] THEN {
                        IF found THEN MakeError["Append by cell type name is ambiguous"];
                        instance _ rct[inst];
                        found _ TRUE;
                        };
                    ENDLOOP;
                ENDLOOP;
            IF NOT found THEN MakeError[Rope.Cat["Can't find instance or cell type of name ", token]];
            state _ sawInstanceNameOrNumber;
            };

        AppendNumberInstance: PROC = {
            rct: CoreClasses.RecordCellType;
            inst: CARDINAL _ Convert.CardFromRope[token];
            path _ AddInstance[path, instance, within];
            within _ IF instance=NIL THEN root ELSE instance.type;
            rct _ NARROW[CoreOps.ToBasic[within].data];
            IF inst>=rct.size THEN MakeError[Rope.Cat["No such instance ", token]];
            instance _ rct[inst];
            state _ sawInstanceNumber;
            };

        CheckCellTypeName: PROC = {
            IF NOT Rope.Equal[token, CoreOps.GetCellTypeName[instance.type]] THEN MakeError[Rope.Cat["Incorrect cell type name ", token]];
            state _ sawCellTypeName;
            };

        <<InstancePath ::= {start} / {expectInstanceNameOrNumber} ( Name | (Number {sawInstanceNumber} ?( ( {sawLeftParan} Name 
        {sawCellTypeName} ) ) )  {sawInstanceNameOrNumber} )>>
        InstancePathParseStates: TYPE = {start, expectInstanceNameOrNumber, sawInstanceNumber, sawLeftParan, sawCellTypeName, 
        sawInstanceNameOrNumber};
        state: InstancePathParseStates _ start;
        within _ root;
        ts _ IO.RIS[pathRope];
        DO
            [token, firstChar, tokenKind] _ ParseToken[ts ! IO.EndOfStream => {tokenKind _ tokenEOF; EXIT}];
            SELECT state FROM
                start => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        '/ => state _ expectInstanceNameOrNumber;
                        '[ => EXIT;
                        ENDCASE => MakeError[];
                    tokenID => EXIT;
                    tokenDECIMAL => EXIT;
                    ENDCASE => MakeError[];
                expectInstanceNameOrNumber => SELECT tokenKind FROM
                    tokenID => AppendNameInstance[];
                    tokenDECIMAL => AppendNumberInstance[];
                    ENDCASE => MakeError[];
                sawInstanceNumber => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        '( => state _ sawLeftParan;
                        '/ => state _ expectInstanceNameOrNumber;
                        '. => EXIT;
                        ENDCASE => MakeError[];
                    ENDCASE => MakeError[];
                sawLeftParan => SELECT tokenKind FROM
                    tokenID => CheckCellTypeName[];
                    ENDCASE => MakeError[];
                sawCellTypeName => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        ') => state _ sawInstanceNameOrNumber;
                        ENDCASE => MakeError[];
                    ENDCASE => MakeError[];
                sawInstanceNameOrNumber => SELECT tokenKind FROM
                    tokenSINGLE => SELECT firstChar FROM
                        '/ => state _ expectInstanceNameOrNumber;
                        '., '[ => EXIT;
                        ENDCASE => MakeError[];
                    ENDCASE => MakeError[];
                ENDCASE => MakeError[];
            ENDLOOP;
        IF state=expectInstanceNameOrNumber OR state=sawLeftParan OR state=sawCellTypeName THEN MakeError[];
        };

    AddInstance: PUBLIC PROC [currentPath: PackedPath, instance: CoreClasses.CellInstance, within: Core.CellType] RETURNS [newPath: 
    PackedPath] = {
        newPath _ currentPath;
        IF instance#NIL THEN {
            withinCT: Core.CellType _ CoreOps.ToBasic[within];
            withinRCT: CoreClasses.RecordCellType _ NARROW[withinCT.data];
            index: NAT _ InstanceIndex[within, instance];
            pathBits: NAT _ BitHacks.NBits[withinRCT.size];
            newPath _ ExtendPath[currentPath, index, pathBits];
            };
        };

    ExtendPath: PROC [currentPath: PackedPath, index: NAT, pathBits: NAT] RETURNS [newPath: PackedPath] = {
        newPath _ currentPath;
        FOR bit: NAT IN [0..pathBits) DO
            newPath.bits[newPath.length+bit] _ BitHacks.XthBitOfN[pathBits-bit-1, index];
            ENDLOOP;
        newPath.length _ newPath.length + pathBits;
        };

    CheckNoMore: PROC [ts: IO.STREAM, firstChar: CHAR, tokenKind: IO.TokenKind] = {
        token: ROPE;
        IF tokenKind=tokenSINGLE AND firstChar='. THEN [token, firstChar, tokenKind] _ ParseToken[ts ! IO.EndOfStream => {tokenKind _ 
        tokenEOF; CONTINUE}];
        IF tokenKind#tokenEOF THEN MakeError[];
        };

    MakeError: PROC [m: ROPE _ NIL] = {
        IF m=NIL THEN m _ "parse failed";
        ERROR PathError[m];
        };

    ParseToken: PROC [ts: IO.STREAM] RETURNS [token: ROPE, firstChar: CHAR, tokenKind: IO.TokenKind] = {
        token _ IO.GetTokenRope[ts, Breaks].token;
        firstChar _ Rope.Fetch[token];
        tokenKind _ SELECT TRUE FROM
            Rope.Length[token]=1 AND Breaks[firstChar]=break => tokenSINGLE,
            firstChar IN ['0..'9] => tokenDECIMAL,
            ENDCASE => tokenID;
        };

    Breaks: IO.BreakProc = {
        RETURN[SELECT char FROM
            IN [IO.NUL .. IO.SP] => sepr,
            '/, '., '(, '), '[, '] => break,
            ENDCASE => other]
        };

    END.