
    <<SiroccoGraphOpsImpl.Mesa>>
        <<Copyright Ó 1986, 1987 by Xerox Corporation.  All rights reserved.>>
        <<Bill Jackson (bj) August 27, 1987 0:55:45 am PDT>>

    DIRECTORY
        IO USING [ STREAM ],
        Rope USING [ ROPE ],
        SiroccoCGDef USING [ Generic, ItemKind, ValueKind ],
        SymTab USING [ EachPairAction, Pairs, Ref ],
        ThreeC4Support USING [ GetReportStream ],
        SiroccoBaseDef USING [ ItemFromContext ],
        SiroccoPrivate,
        SiroccoPrivateTypes;

    SiroccoGraphOpsImpl: CEDAR PROGRAM
        IMPORTS SiroccoBaseDef, SiroccoPrivate, SymTab, ThreeC4Support
        EXPORTS SiroccoBaseDef ~ {
        OPEN SiroccoBaseDef, SiroccoCGDef, SiroccoPrivate, SiroccoPrivateTypes;
        ROPE: TYPE ~ Rope.ROPE;
        STREAM: TYPE ~ IO.STREAM;
    <<Graph Searching>>
        AssertTypeGraphAcyclic: PUBLIC PROC [ graph: TypeGraph ]
        RETURNS [ acyclic: BOOLEAN ] ~ {
            s: STREAM ~ ThreeC4Support.GetReportStream[];
            WalkTypeGraph[s, graph];
            acyclic _ TRUE;
            };
        AssertValueGraphAcyclic: PUBLIC PROC [ graph: TypeGraph ]
        RETURNS [ acyclic: BOOLEAN ] ~ {
            DumpTypeGraph[graph];
            acyclic _ TRUE;
            };
    <<Walk/Snarf Object files>>
        WalkTypeGraph: PUBLIC PROC [ s: STREAM, graph: TypeGraph ] ~ {
        EachItem: SymTab.EachPairAction ~ {
            item: ITEM ~ NARROW[val]; -- guaranteed to be indirect!
            WalkItemTG[s, item, context];
            };
        context: CONTEXT ~ graph.context;
            scope: SCOPE ~ context.scope;
            items: SymTab.Ref ~ scope.items;
            [] _ SymTab.Pairs[items, EachItem];
            };

        WalkItemTG: TGNWalkProc ~ {
            ENABLE { UNWIND => NULL };
        item: ITEM ~ NARROW[node];
        name: ROPE ~ item.name;
            position: CARD ~ item.position;
        kind: SiroccoCGDef.ItemKind ~ item.kind;
        type: TypeGraphNode ~ item.type;
        value: AbstractValue ~ item.value;
            state: GraphTraversalState ~ item.state;
            SELECT TRUE FROM
                ( state = completed ) => { RETURN };
                ( state = unvisited ) => { item.state _ inprogress };
                ( state = inprogress ) => { CycleInGraph[name]; RETURN };
                ENDCASE;
            SELECT kind FROM
                type => {
                    WalkTGN[s, type, context];
                    };
                const => {
                    WalkTGN[s, type, context];
                    WalkAVN[s, value, context];
                    };
                ENDCASE => { ERROR }; -- impossible?
            item.state _ completed;
            };
    <<Type Graph/Node Creators>>
        <<internal for now!>>
    MarkTypeGraphNode: PROC [ node: TypeGraphNode ] ~ {
        };

        WalkTGN: PUBLIC TGNWalkProc ~ {
            IF ( node = NIL ) THEN RETURN;
            MarkTypeGraphNode[node]; -- unneccessary?
            WITH node SELECT FROM
                tgn: REF NodeRep    => { WalkIndirectTGN[s, tgn, context]; };
                tgn: HackTGN    => { WalkHackTGN[s, tgn, context]; };

                tgn: ArrayTGN    => { WalkArrayTGN[s, tgn, context]; };
                tgn: BaseTypeTGN    => { WalkBaseTypeTGN [s, tgn, context]; };
                tgn: ChoiceTGN    => { WalkChoiceTGN [s, tgn, context]; };
                tgn: DerefTGN    => { WalkDerefTGN [s, tgn, context]; };
                tgn: EnumTGN    => { WalkEnumTGN [s, tgn, context]; };
                tgn: ErrorTGN    => { WalkErrorTGN [s, tgn, context]; };
                tgn: LinkTGN    => { WalkLinkTGN [s, tgn, context]; };
                tgn: ProcTGN    => { WalkProcTGN [s, tgn, context]; };
                tgn: RecordTGN    => { WalkRecordTGN [s, tgn, context]; };
                tgn: SequenceTGN    => { WalkSequenceTGN [s, tgn, context]; };
                tgn: FieldListTGN    => { WalkFieldListTGN [s, tgn, context]; };
                tgn: UnionTGN    => { WalkUnionTGN [s, tgn, context]; };
                tgn: FieldTGN    => { WalkFieldTGN [s, tgn, context]; };
                ENDCASE        => { UnknownNodeType[node] };
            };

        WalkIndirectTGN: PUBLIC TGNWalkProc ~ {
            tgn: REF NodeRep ~ NARROW[node];
        WalkTGN[s, tgn.specifics, context];
            };

        WalkHackTGN: PUBLIC TGNWalkProc ~ {
            tgn: HackTGN ~ NARROW[node];
        WalkTGN[s, tgn.value, context];
        WalkTGN[s, tgn.next, context];
            };
    <<Primitive Creators>>
        WalkEmptyTGN: PUBLIC TGNWalkProc ~ {
            };
        WalkPrimitiveTGN: PUBLIC TGNWalkProc ~ {
            };
    <<Primary Creators>>
        WalkArrayTGN: PUBLIC TGNWalkProc ~ {
            atgn: ArrayTGN ~ NARROW[node];
        WalkAVN[s, atgn.length, context];
        WalkTGN[s, atgn.itemType, context];
            };
        WalkBaseTypeTGN: PUBLIC TGNWalkProc ~ {
            btgn: BaseTypeTGN ~ NARROW[node];
            };
        WalkChoiceTGN: PUBLIC TGNWalkProc ~ {
            ctgn: ChoiceTGN ~ NARROW[node];
        WalkTGN[s, ctgn.ktype, context];
        WalkTGN[s, ctgn.union, context];
            };
        WalkDerefTGN: PUBLIC TGNWalkProc ~ {
            tgn: DerefTGN ~ NARROW[node];
            referent: ITEM _ ItemFromContext[context, tgn.item];
        WalkItemTG[s, referent, context];
            };
        WalkEnumTGN: PUBLIC TGNWalkProc ~ {
            etgn: EnumTGN ~ NARROW[node];
        WalkTGN[s, etgn.enum, context];
            };
        WalkErrorTGN: PUBLIC TGNWalkProc ~ {
            etgn: ErrorTGN ~ NARROW[node];
        WalkTGN[s, etgn.fieldlist, context];
            };
        WalkLinkTGN: PUBLIC TGNWalkProc ~ {
            tgn: LinkTGN ~ NARROW[node];
            imports: CONTEXT ~ context; -- RemoteContext[context, interface];
            referent: ITEM _ ItemFromContext[imports, tgn.item];
        WalkItemTG[s, referent, context];
            };
        WalkProcTGN: PUBLIC TGNWalkProc ~ {
            tgn: ProcTGN ~ NARROW[node];
        WalkTGN[s, tgn.args, context];
        WalkTGN[s, tgn.results, context];
        WalkTGN[s, tgn.errors, context];
            };
        WalkRecordTGN: PUBLIC TGNWalkProc ~ {
            tgn: RecordTGN ~ NARROW[node];
        WalkTGN[s, tgn.fieldlist, context];
            };
        WalkSequenceTGN: PUBLIC TGNWalkProc ~ {
            tgn: SequenceTGN ~ NARROW[node];
        WalkAVN[s, tgn.maxlength, context];
        WalkTGN[s, tgn.subtype, context];
            };
    <<Secondary Creators>>
        WalkFieldListTGN: PUBLIC TGNWalkProc ~ {
            tgn: FieldListTGN ~ NARROW[node];
        WalkAVN[s, tgn.ordinal, context];
            };
        WalkUnionTGN: PUBLIC TGNWalkProc ~ {
            tgn: UnionTGN ~ NARROW[node];
        WalkTGN[s, tgn.namelist, context];
        WalkTGN[s, tgn.type, context];
            };
        WalkFieldTGN: PUBLIC TGNWalkProc ~ {
            tgn: FieldTGN ~ NARROW[node];
        WalkTGN[s, tgn.namelist, context];
        WalkTGN[s, tgn.type, context];
            };
        WalkEmptyFieldTGN: PUBLIC TGNWalkProc ~ {
            };
    <<Abstract Value Node Creators>>
        <<internal for now!>>
        WalkGenericAVN: PUBLIC AVNWalkProc ~ {
            };
    MarkAbstractValue: PROC [value: AbstractValue] ~ {
        };

        WalkAVN: PUBLIC AVNWalkProc ~ {
            IF ( value = NIL ) THEN RETURN;
            MarkAbstractValue[value]; -- unneccessary?
            WITH value SELECT FROM
                avn: REF AbstractValueObject    => { WalkIndirectAVN[s, avn, context]; };
                avn: HackAVN    => { WalkHackAVN[s, avn, context]; };

                <<avn: NullAVN    => { WalkNullAVN [s, avn, context]; };>>
                avn: LogicalAVN    => { WalkLogicalAVN [s, avn, context]; };
                avn: NumericalAVN    => { WalkNumericalAVN [s, avn, context]; };
                avn: RopeAVN    => { WalkRopeAVN [s, avn, context]; };

                avn: BindingAVN    => { WalkBindingAVN [s, avn, context]; };
                avn: ConstructorAVN    => { WalkConstructorAVN [s, avn, context]; };
                avn: DerefAVN    => { WalkDerefAVN [s, avn, context]; };
                avn: GroupingAVN    => { WalkGroupingAVN [s, avn, context]; };
                avn: LinkAVN    => { WalkLinkAVN [s, avn, context]; };
                avn: VariantAVN    => { WalkVariantAVN [s, avn, context]; };
                ENDCASE        => { UnknownNodeType[value] };
            };

        WalkIndirectAVN: PUBLIC AVNWalkProc ~ {
            avn: REF AbstractValueObject ~ NARROW[value];
        WalkAVN[s, avn.specifics, context];
            };

        WalkHackAVN: PUBLIC AVNWalkProc ~ {
            avn: HackAVN ~ NARROW[value];
        WalkAVN[s, avn.value, context];
        WalkAVN[s, avn.next, context];
            };
    <<Primary Creators>>
        WalkNullAVN: PUBLIC AVNWalkProc ~ {
            };

        WalkLogicalAVN: PUBLIC AVNWalkProc ~ {
            };
        WalkNumericalAVN: PUBLIC AVNWalkProc ~ {
            };
        WalkRopeAVN: PUBLIC AVNWalkProc ~ {
            };
    <<Secondary Creators>>
        WalkBindingAVN: PUBLIC AVNWalkProc ~ {
            avn: BindingAVN ~ NARROW[value];
        WalkTGN[s, avn.tgn, context];
        WalkAVN[s, avn.node, context];
            };
        WalkConstructorAVN: PUBLIC AVNWalkProc ~ {
            avn: ConstructorAVN ~ NARROW[value];
        WalkAVN[s, avn.node, context];
            };
        WalkDerefAVN: PUBLIC AVNWalkProc ~ {
            avn: DerefAVN ~ NARROW[value];
            referent: ITEM _ ItemFromContext[context, avn.item];
        WalkItemTG[s, referent, context];
            };
        WalkGroupingAVN: PUBLIC AVNWalkProc ~ {
            avn: GroupingAVN ~ NARROW[value];
        WalkAVN[s, avn.node, context];
            };
        WalkLinkAVN: PUBLIC AVNWalkProc ~ {
            avn: LinkAVN ~ NARROW[value];
            imports: CONTEXT ~ context; -- RemoteContext[context, interface];
            referent: ITEM _ ItemFromContext[imports, avn.item];
        WalkItemTG[s, referent, context];
            };
        WalkVariantAVN: PUBLIC AVNWalkProc ~ {
            avn: VariantAVN ~ NARROW[value];
        WalkAVN[s, avn.node, context];
            };
    <<Error Handling>>
        Something: SIGNAL ~ CODE;

        UndefinedSymbol: PROC [ name: ROPE ] ~ {
            SIGNAL Something;
            };

        CycleInGraph: PROC [ name: ROPE ] ~ {
            SIGNAL Something;
            };

        UnknownNodeType: PROC [ node: REF ] ~ {
            SIGNAL Something;
            };

        }.