
    <<CoreTracingImpl.Mesa>>
        <<Mike Spreitzer March 10, 1987 1:38:12 pm PST>>

    DIRECTORY Core, CoreClasses, CoreOps, CoreProperties, CoreTracing, IO, PartialOrders, RefTab;

    CoreTracingImpl: CEDAR PROGRAM
        IMPORTS CoreClasses, CoreOps, CoreProperties, CoreTracing, IO, PartialOrders, RefTab
        EXPORTS CoreTracing

    = BEGIN OPEN Core, CoreClasses, CO: CoreOps, CP: CoreProperties, CoreTracing, PO: PartialOrders;

    RefInt: TYPE = REF INT;
    CellTypeList: TYPE ~ LIST OF CellType;

    Reg: PROC [a: ATOM] RETURNS [ATOM]
        ~ {RETURN [CP.RegisterUnprintableProperty[a]]};

    containerProp: ATOM ~ Reg[$CoreTraceToContainingCellType];
    instancesProp: ATOM ~ Reg[$CoreTraceCellTypeToInstances];
    connectionsProp: ATOM ~ Reg[$CoreTraceWireToConnections];
    seqProp: ATOM ~ Reg[$CoreTraceIsRootWireSequence];
    seqsProp: ATOM ~ Reg[$CoreTraceCellTypeToSequencesOfIt];
    upWireProp: ATOM ~ Reg[$CoreTraceWireUpward];
    publicIndexProp: ATOM ~ Reg[$CoreTraceWireToPublicIndex];
    simplestProp: ATOM ~ Reg[$CoreTraceCellTypeToSimplest];

    noPath: PUBLIC Path ~ LIST[noIndex];

    ConsOuter: PUBLIC PROC [i: Index, p: Path] RETURNS [Path]
        ~ {RETURN [IF p=NIL THEN LIST[i] ELSE CONS[p.first, ConsOuter[i, p.rest]]]};

    Outsplit: PUBLIC PROC [p: Path] RETURNS [first: Index, rest: Path]
        ~ {IF p.rest = NIL THEN RETURN [p.first, NIL] ELSE {
            [first, rest] _ Outsplit[p.rest];
            RETURN [first, CONS[p.first, rest]]}};

    PathCat: PUBLIC PROC [inner, outer: Path] RETURNS [Path] ~ {
        RETURN [
            IF inner=NIL THEN outer
            ELSE IF outer=NIL THEN inner
            ELSE IF inner.rest=NIL THEN CONS[inner.first, outer]
            ELSE CONS[inner.first, PathCat[inner.rest, outer]]]};

    SubWire: PUBLIC PROC [w: Wire, p: Path] RETURNS [Wire] ~ {
        RETURN [
            IF p=NIL THEN w
            ELSE IF p.rest=NIL THEN w[p.first]
            ELSE SubWire[w, p.rest][p.first]
            ]};

    Simplify: PUBLIC PROC [anyCellType: CellType] RETURNS [cellType: CellType, recordCellType: RecordCellType] = {
        cellType _ NARROW[CP.GetCellTypeProp[anyCellType, simplestProp]];
        IF cellType = NIL THEN {
            FOR cellType _ anyCellType, CO.Recast[cellType] UNTIL cellType.class.recast = NIL DO NULL ENDLOOP;
            CP.PutCellTypeProp[anyCellType, simplestProp, cellType];
            };
        WITH cellType.data SELECT FROM
            x: RecordCellType => recordCellType _ x;
            ENDCASE => recordCellType _ NIL;
        };

    EnumeratorForSingleton: PUBLIC PROC [s: REF ANY] RETURNS [e: Enumerator] = {
        e _ NEW [EnumeratorPrivate _ [EnumerateSingleton, s]];
        };

    EnumerateSingleton: PROC [data: REF ANY, Consumer: PROC [REF ANY]] = {
        Consumer[data];
        };

    EnumeratorForHashTable: PUBLIC PROC [ht: RefTab.Ref, key, value: BOOL] RETURNS [e: Enumerator] = {
        hte: HashTableEnumeration = NEW [HashTableEnumerationPrivate _ [ht, key, value]];
        e _ NEW [EnumeratorPrivate _ [EnumerateHashTable, hte]];
        };

    HashTableEnumeration: TYPE = REF HashTableEnumerationPrivate;
    HashTableEnumerationPrivate: TYPE = RECORD [
        ht: RefTab.Ref, key, value: BOOL];

    EnumerateHashTable: PROC [data: REF ANY, Consumer: PROC [REF ANY]] = {
        hte: HashTableEnumeration = NARROW[data];
        PerPair: PROC [key, val: REF ANY] RETURNS [quit: BOOLEAN _ FALSE] --RefTab.EachPairAction-- = {
            IF hte.key THEN Consumer[key];
            IF hte.value THEN Consumer[val];
            };
        [] _ hte.ht.Pairs[PerPair];
        };

    EnumeratorForPartialOrder: PUBLIC PROC [po: PartialOrder, direction: PO.Direction] RETURNS [e: Enumerator] = {
        poe: PartialOrderEnumeration = NEW [PartialOrderEnumerationPrivate _ [po, direction]];
        e _ NEW [EnumeratorPrivate _ [EnumeratePartialOrder, poe]];
        };

    PartialOrderEnumeration: TYPE = REF PartialOrderEnumerationPrivate;
    PartialOrderEnumerationPrivate: TYPE = RECORD [
        po: PO.PartialOrder, direction: PO.Direction];

    EnumeratePartialOrder: PROC [data: REF ANY, Consumer: PROC [REF ANY]] = {
        poe: PartialOrderEnumeration = NARROW[data];
        PerElt: PROC [rank: INT, elt: PO.Element, v: PO.Vertex] --PartialOrder.Consumer-- = {
            Consumer[elt];
            };
        [] _ poe.po.Enumerate[poe.direction, NIL, PerElt];
        };

    EnumeratorForReachable: PUBLIC PROC [e0: Enumerator] RETURNS [e: Enumerator] = {
        e _ NEW [EnumeratorPrivate _ [EnumerateReachable, e0]];
        };

    EnumerateReachable: PROC [data: REF ANY, Consumer: PROC [REF ANY]] = {
        e0: Enumerator = NARROW[data];
        seen: RefTab.Ref = RefTab.Create[];
        SeeAny: PROC [ra: REF ANY] = {SeeCellType[NARROW[ra]]};
        SeeCellType: PROC [ct: CellType] = {
            quaRecord: RecordCellType = Simplify[ct].recordCellType;
            IF NOT seen.Insert[ct, $T] THEN RETURN;
            Consumer[ct];
            IF quaRecord # NIL THEN {
                FOR i: INT IN [0 .. quaRecord.size) DO SeeCellType[quaRecord[i].type] ENDLOOP;
                };
            };
        e0.Enumerate[e0.data, SeeAny];
        };

    Count: PUBLIC PROC [e: Enumerator, limit: INT _ INT.LAST] RETURNS [i: INT] = {
        PerElt: PROC [REF ANY] = {IF (i _ i + 1) >= limit THEN Enuf};
        i _ 0;
        e.Enumerate[e.data, PerElt !Enuf => CONTINUE];
        };
        Enuf: ERROR = CODE;

    GetOne: PUBLIC PROC [e: Enumerator] RETURNS [elt: REF ANY] = {
        PerElt: PROC [x: REF ANY] = {elt _ x; Enuf};
        elt _ NIL;
        e.Enumerate[e.data, PerElt !Enuf => CONTINUE];
        };

    Prepare: PUBLIC PROC [e: Enumerator--of all CellTypes--] = {
        Clear: PROC [ra: REF ANY] = {
            urCellType: CellType = NARROW[ra];
            cellType: CellType;
            recordCellType: RecordCellType;
            [cellType, recordCellType] _ Simplify[urCellType];
            CP.PutCellTypeProp[urCellType, instancesProp, NIL];
            CP.PutCellTypeProp[urCellType, seqsProp, NIL];
            IF recordCellType = NIL THEN RETURN;
            ClearCellType[urCellType, cellType, recordCellType];
            };
        Note: PROC [ra: REF ANY] = {
            urCellType: CellType = NARROW[ra];
            cellType: CellType;
            recordCellType: RecordCellType;
            public: Wire _ urCellType.public;
            [cellType, recordCellType] _ Simplify[urCellType];
            NoteCellType[urCellType, cellType, recordCellType, TRUE];
            };
        e.Enumerate[e.data, Clear];
        e.Enumerate[e.data, Note];
        };

    ClearCellType: PROC [urCellType, cellType: CellType, recordCellType: RecordCellType] = {
        internal: Wire;
        CP.PutWireProp[urCellType.public, seqProp, NIL];
        IF recordCellType = NIL THEN RETURN;
        internal _ recordCellType.internal;
        CP.PutWireProp[internal, seqProp, NIL];
        RemoveLocalConnections[internal];
        };

    NoteCellType: PROC [urCellType, cellType: CellType, recordCellType: RecordCellType, instanceStuffToo: BOOL] = {
        public: Wire ~ urCellType.public;
        AddLocalConnection[public, NIL, NIL];
        IF urCellType.class = sequenceCellClass THEN {
            seq: SequenceCellType ~ NARROW[urCellType.data];
            seqs: CellTypeList _ NARROW[CP.GetCellTypeProp[seq.base, seqsProp]];
            seqs _ CONS[urCellType, seqs];
            CP.PutCellTypeProp[seq.base, seqsProp, seqs];
            };
        IF recordCellType = NIL THEN RETURN;
        {internal: Wire ~ recordCellType.internal;
        FOR i: INT IN [0 .. recordCellType.size) DO
            ci: CellInstance = recordCellType[i];
            actual: Wire = ci.actual;
            IF instanceStuffToo THEN {
                instances: InstanceList _ NARROW[CP.GetCellTypeProp[ci.type, instancesProp]];
                instances _ CONS[ci, instances];
                CP.PutCellTypeProp[ci.type, instancesProp, instances];
                CP.PutCellInstanceProp[ci, containerProp, urCellType];
                };
            AddLocalConnection[actual, ci, NIL];
            ENDLOOP;
        SetUpLink[internal, NIL, urCellType, noIndex];
        instanceStuffToo _ instanceStuffToo;
        }};

    AddLocalConnection: PROC [wire: Wire, ci: CellInstance, path: Path] ~ {
        IF path = NIL THEN {
            CP.PutWireProp[wire, seqProp, $TRUE];
            }
        ELSE {
            connections: LocalConnectionList _ NARROW[CP.GetWireProp[wire, connectionsProp]];
            IF ci = NIL THEN CP.PutWireProp[wire, publicIndexProp, path];
            connections _ CONS[
                NEW [LocalConnectionPrivate _ [NIL, ci, path]],
                connections];
            CP.PutWireProp[wire, connectionsProp, connections];
            };
        FOR i: Index IN [0 .. wire.size) DO
            AddLocalConnection[wire[i], ci, ConsInner[i, path]];
            ENDLOOP;
        };

    RemoveLocalConnections: PROC [wire: Wire] ~ {
        CP.PutWireProp[wire, connectionsProp, NIL];
        CP.PutWireProp[wire, publicIndexProp, NIL];
        FOR i: Index IN [0 .. wire.size) DO
            RemoveLocalConnections[wire[i]];
            ENDLOOP;
        };

    SetUpLink: PROC [wire, parent: Wire, container: CellType, index: Index] ~ {
        IF parent = NIL THEN {
            CP.PutWireProp[wire, seqProp, $TRUE];
            }
        ELSE {
            wul: WireUpLink ~ NEW [WireUpLinkPrivate _ [parent, index]];
            CP.PutWireProp[wire, upWireProp, wul];
            CP.PutWireProp[wire, containerProp, container];
            };
        FOR i: Index IN [0 .. wire.size) DO
            SetUpLink[wire[i], wire, container, i];
            ENDLOOP;
        };

    Repair: PUBLIC PROC [urCellType: CellType] = {
        cellType: CellType;
        recordCellType: RecordCellType;
        [cellType, recordCellType] _ Simplify[urCellType];
        ClearCellType[urCellType, cellType, recordCellType];
        NoteCellType[urCellType, cellType, recordCellType, FALSE];
        };

    WireContainer: PUBLIC PROC [w: Wire] RETURNS [ct: CellType] = {
        ct _ NARROW[CP.GetWireProp[w, containerProp]];
        };

    UpWire: PUBLIC PROC [w: --internal--Wire] RETURNS [parent: Wire, index: Index] ~ {
        wul: WireUpLink ~ NARROW[CP.GetWireProp[w, upWireProp]];
        RETURN [wul.parent, wul.index];
        };

    InstanceContainer: PUBLIC PROC [ci: CellInstance] RETURNS [ct: CellType] = {
        ct _ NARROW[CP.GetCellInstanceProp[ci, containerProp]];
        };

    WirePublicity: PUBLIC PROC [w: Wire] RETURNS [public: BOOL, publicPath: Path] = {
        x: Path ~ NARROW[CP.GetWireProp[w, publicIndexProp]];
        IF x # NIL THEN RETURN [TRUE, x];
        CheckWireSeq[w];
        RETURN [FALSE, noPath];
        };

    IsInternal: PUBLIC PROC [w: Wire] RETURNS [internal: BOOL] = {
        internal _ CP.GetWireProp[w, containerProp] # NIL;
        };

    IsWireSeq: PUBLIC PROC [ref: REF WireRec] RETURNS [BOOL] ~ {
    WITH CP.GetWireProp[ref, upWireProp] SELECT FROM
    wul: WireUpLink => RETURN [FALSE];
    ENDCASE => SELECT CP.GetWireProp[ref, seqProp] FROM
    $TRUE => RETURN [TRUE];
    ENDCASE => ERROR;
        };

    CheckWireSeq: PUBLIC PROC [ref: REF WireRec, shouldBeSeq: BOOL _ FALSE] ~ {
    IF IsWireSeq[ref] # shouldBeSeq THEN ERROR;
        };

    Atomic: PUBLIC PROC [cellType: CellType] RETURNS [atomic: BOOL] = {
        atomic _ Simplify[cellType].recordCellType = NIL;
        };

    EnumeratorForLocalConnections: PUBLIC PROC [wire: Wire] RETURNS [e: Enumerator] = {
        IF NOT IsInternal[wire] THEN ERROR;
        e _ NEW [EnumeratorPrivate _ [EnumerateLocalConnections, wire]];
        };

    EnumerateLocalConnections: PUBLIC PROC [data: REF ANY, Consumer: PROC [REF ANY]] = {
        ImmediateEnumerate: PROC [w: Wire, subscript: Path, prefix: LIST OF Index] ~ {
            connections: LocalConnectionList _ NARROW[CP.GetWireProp[w, connectionsProp]];
            FOR connections _ connections, connections.rest WHILE connections # NIL DO
                lc: LocalConnection _ connections.first;
                IF prefix#NIL OR subscript#NIL THEN {
                    lc _ NEW [LocalConnectionPrivate _ lc^];
                    FOR pl: LIST OF Index _ prefix, pl.rest WHILE pl # NIL DO
                        lc.publicPath _ CONS[pl.first, lc.publicPath];
                        ENDLOOP;
                    lc.subscript _ PathCat[subscript, lc.subscript];
                    };
                Consumer[lc];
                ENDLOOP;
            };
        DoChildren: PROC [w: Wire, subscript: Path] ~ {
            FOR i: Index IN [0 .. w.size) DO
                ss: Path ~ ConsInner[i, subscript];
                ImmediateEnumerate[w[i], ss, NIL];
                DoChildren[w[i], ss];
                ENDLOOP;
            };
        w: Wire _ NARROW[data];
        prefix: LIST OF Index _ NIL;
        IF NOT IsInternal[w] THEN ERROR;
        --do w and up--DO
            ImmediateEnumerate[w, NIL, prefix];
            {parent: Wire;
            index: Index;
            [parent, index] _ UpWire[w];
            IF IsWireSeq[parent] THEN EXIT;
            prefix _ CONS[index, prefix];
            }ENDLOOP;
        DoChildren[NARROW[data], NIL];
        data _ data};

    EnumeratorForSequences: PUBLIC PROC [cellType: CellType] RETURNS [Enumerator] ~ {
        RETURN [NEW [EnumeratorPrivate _ [EnumerateSequences, cellType]]];
        };

    EnumerateSequences: PUBLIC PROC [data: REF ANY, Consumer: PROC [REF ANY]] ~ {
        cellType: CellType ~ NARROW[data];
        FOR seqs: CellTypeList _ NARROW[CP.GetCellTypeProp[cellType, seqsProp]], seqs.rest WHILE seqs # NIL DO
            Consumer[seqs.first];
            ENDLOOP;
        data _ data;
        };

    EnumeratorForInstances: PUBLIC PROC [cellType: CellType] RETURNS [e: Enumerator] = {
        e _ NEW [EnumeratorPrivate _ [EnumerateInstances, cellType]];
        };

    EnumerateInstances: PUBLIC PROC [data: REF ANY, Consumer: PROC [REF ANY]] = {
        cellType: CellType = NARROW[data];
        instances: InstanceList _ NARROW[CP.GetCellTypeProp[cellType, instancesProp]];
        FOR instances _ instances, instances.rest WHILE instances # NIL DO
            Consumer[instances.first];
            ENDLOOP;
        data _ data};

    EnumeratorForGlobalInstances: PUBLIC PROC [cellType: CellType] RETURNS [e: Enumerator] = {
        e _ NEW [EnumeratorPrivate _ [EnumerateGlobalInstances, cellType]];
        };

    EnumerateGlobalInstances: PUBLIC PROC [data: REF ANY, Consumer: PROC [REF ANY]] = {
        cellType: CellType = NARROW[data];
        Work: PROC [ct: CellType, tail: InstanceList] = {
            instances: InstanceList _ NARROW[CP.GetCellTypeProp[cellType, instancesProp]];
            SELECT TRUE FROM
                instances = NIL => {--a root
                    Consumer[tail];
                    };
                instances # NIL => {
                    FOR instances _ instances, instances.rest WHILE instances # NIL DO
                        ci: CellInstance = instances.first;
                        IF ci.type # ct THEN ERROR;
                        Work[InstanceContainer[ci], CONS[ci, tail]];
                        ENDLOOP;
                    };
                ENDCASE => ERROR;
            data _ data};
        Work[cellType, NIL];
        data _ data};

    EnumeratorForWiresOfNode: PUBLIC PROC [wire: Wire] RETURNS [e: Enumerator] = {
        IF NOT IsInternal[wire] THEN ERROR;
        e _ NEW [EnumeratorPrivate _ [EnumerateWiresOfNode, wire]];
        };

    EnumerateWiresOfNode: PUBLIC PROC [data: REF ANY, Consumer: PROC [REF ANY]] = {
        w: Wire = NARROW[data];
        seen: RefTab.Ref = RefTab.Create[];
        See: PROC [wire: Wire] = {
            IF NOT seen.Insert[wire, $T] THEN RETURN;
            IF NOT IsInternal[wire] THEN ERROR;
            Consumer[wire];
            -- look upward-- {
                publicPath: Path = WirePublicity[wire].publicPath;
                SeeUpper: PROC [ra: REF ANY] = {
                    uci: CellInstance = NARROW[ra];
                    See[SubWire[uci.actual, publicPath]]
                    };
                IF publicPath # noPath THEN EnumerateInstances[WireContainer[wire], SeeUpper];
                };
            -- look downard -- {
                SeeDown: PROC [ra: REF ANY] = {
                    lc: LocalConnection = NARROW[ra];
                    IF NOT Atomic[lc.ci.type] THEN See[SubWire[lc.ci.type.public, lc.publicPath]];
                };
                EnumerateLocalConnections[wire, SeeDown];
                };
            };
        See[w];
        seen.Erase[];
        data _ data};

    EnumeratorForLeafConnections: PUBLIC PROC [wire: Wire] RETURNS [e: Enumerator] = {
        IF NOT IsInternal[wire] THEN ERROR;
        e _ NEW [EnumeratorPrivate _ [EnumerateLeafConnections, wire]];
        };

    EnumerateLeafConnections: PUBLIC PROC [data: REF ANY, Consumer: PROC [REF ANY]] = {
        w: Wire = NARROW[data];
        PerWire: PROC [ra: REF ANY] = {
            wire: Wire = NARROW[ra];
            PerLocalConnection: PROC [ra: REF ANY] = {
                lc: LocalConnection = NARROW[ra];
                IF Atomic[lc.ci.type] THEN Consumer[lc];
                };
            EnumerateLocalConnections[wire, PerLocalConnection];
            };
        EnumerateWiresOfNode[w, PerWire];
        data _ data};

    PrintTable: PUBLIC PROC [to: IO.STREAM, table: RefTab.Ref] ~ {
        sep: ROPE _ NIL;
        PrintPair: PROC [key, val: REF ANY] RETURNS [quit: BOOL _ FALSE]  --RefTab.EachPairAction-- ~ {
            name: ROPE ~ NARROW[key];
            to.PutRope[sep];
            to.PutRope[name];
            sep _ ", ";
            };
        IF table.Pairs[PrintPair] THEN ERROR;
        };

    END.