
<<TypeGraphs.Mesa>>
    <<Mike Spreitzer September 27, 1986 3:35:20 pm PDT>>

    DIRECTORY AMTypes, Graphs, Rope;

    TypeGraphs: CEDAR PROGRAM
        IMPORTS AMTypes, Graphs, Rope =

    BEGIN

    ROPE: TYPE = Rope.ROPE;

    TypeRef: TYPE = REF Type;
    Type: TYPE = AMTypes.Type;

    NewTypeVertex: PROC [type: AMTypes.Type] RETURNS [vertex: Graphs.Vertex] =
        BEGIN
        vertex _ [
            class: typeVertexClass,
            rep: NEW [Type _ type]]
        END;

    ExpandType: PROC [vertex: Graphs.Vertex, Consume: Graphs.EdgeConsumer, filter: Graphs.DirectionFilter _ Graphs.allDirections] 
    --Graphs.ExpandProc-- = {
        tr: TypeRef = NARROW[vertex.rep];
        tc: AMTypes.Class = AMTypes.TypeClass[tr^];
        IF filter[Incoming] THEN Graphs.Error[Cant];
        IF NOT filter[Outgoing] THEN RETURN;
        SELECT tc FROM
            record, structure => BEGIN
                FOR i: INT IN [1 .. AMTypes.NComponents[tr^]] DO
                    Consume[
                        [AMTypes.IndexToName[type: tr^, index: i], edgeClass],
                        Outgoing,
                        NewTypeVertex[AMTypes.IndexToType[type: tr^, index: i]]
                        ];
                    ENDLOOP;
                END;
            ref, pointer, longPointer => Consume[["referent", edgeClass], Outgoing,  NewTypeVertex[AMTypes.Range[tr^]]];
            definition => Consume[["definition", edgeClass], Outgoing, NewTypeVertex[AMTypes.UnderType[tr^]]];
            array, sequence, procedure => {
                Consume[["arg", edgeClass], Outgoing, NewTypeVertex[AMTypes.Domain[tr^]]];
                Consume[["result", edgeClass], Outgoing, NewTypeVertex[AMTypes.Range[tr^]]];
                };
            ENDCASE;
        };

    EnumerateTypeLabels: PROC [vertex: Graphs.Vertex, Consume: Graphs.LabelConsumer, filter: Graphs.DirectionFilter _ 
    Graphs.allDirections] --Graphs.LabelEnumerator-- = {
        tr: TypeRef _ NARROW[vertex.rep];
        tc: AMTypes.Class _ AMTypes.TypeClass[tr^];
        IF filter[Incoming] THEN Graphs.Error[Cant];
        IF NOT filter[Outgoing] THEN RETURN;
        SELECT tc FROM
            record, structure => BEGIN
                FOR i: INT IN [1 .. AMTypes.NComponents[tr^]] DO
                    Consume[Outgoing, AMTypes.IndexToName[type: tr^, index: i], NIL];
                    ENDLOOP;
                END;
            ref, pointer, longPointer => Consume[Outgoing, "referent", NIL];
            definition => Consume[Outgoing, "definition", NIL];
            array, sequence, procedure => BEGIN
                Consume[Outgoing, "arg", NIL];
                Consume[Outgoing, "result", NIL];
                END;
            ENDCASE;
        };

    GetNeighbor: PROC [vertex: Graphs.Vertex, filter: Graphs.DirectionFilter _ Graphs.allDirections, edgeLabel, vertexLabel: ROPE _ 
    Graphs.unlabeled, index: INT--origin 1-- _ Graphs.noIndex, goal: Graphs.Vertex _ Graphs.nullVertex] RETURNS [edge: Graphs.Edge, 
    neighbor: Graphs.Vertex] --Graphs.NeighborGetter-- =
        BEGIN
        tr: TypeRef = NARROW[vertex.rep];
        tc: AMTypes.Class = AMTypes.TypeClass[tr^];
        Check: PROC [e: Graphs.Edge, n: Graphs.Vertex, i: Graphs.Index] = {
            IF index # Graphs.noIndex AND index # i THEN Graphs.Error[BadArgs];
            IF edgeLabel # Graphs.unlabeled AND NOT edgeLabel.Equal[NARROW[e.rep]] THEN Graphs.Error[BadArgs];
            };
        IF filter[Incoming] THEN Graphs.Error[Cant];
        IF NOT filter[Outgoing] THEN RETURN [Graphs.nullEdge, Graphs.nullVertex];
        IF vertexLabel # Graphs.unlabeled THEN Graphs.Error[BadArgs];
        IF goal # Graphs.nullVertex THEN [edge, neighbor] _ Graphs.GetNeighborFromExpand[vertex, filter, edgeLabel, vertexLabel, index, 
        goal];
        SELECT tc FROM
            record, structure => NULL;
            ref, pointer, longPointer => {Check[["referent", edgeClass], NewTypeVertex[AMTypes.Range[tr^]], 1]; RETURN};
            definition => {Check[["definition", edgeClass], NewTypeVertex[AMTypes.UnderType[tr^]], 1]; RETURN};
            array, sequence, procedure => NULL;
            ENDCASE => ERROR;
        SELECT TRUE FROM
            index # Graphs.noIndex => {
                SELECT tc FROM
                    record, structure => {
                        ctr: TypeRef = NEW [Type _ AMTypes.IndexToType[type: tr^, index: index]];
                        Check[[AMTypes.IndexToName[tr^, index], edgeClass], [ctr, typeVertexClass], index];
                        };
                    ref, pointer, longPointer => ERROR;
                    definition => ERROR;
                    array, sequence, procedure => SELECT index FROM
                        1 => {Check[["arg", edgeClass], NewTypeVertex[AMTypes.Domain[tr^]], 1]};
                        2 => {Check[["result", edgeClass], NewTypeVertex[AMTypes.Range[tr^]], 2]};
                        ENDCASE => Graphs.Error[BadArgs];
                    ENDCASE => ERROR;
                };
            edgeLabel # Graphs.unlabeled => {
                SELECT tc FROM
                    record, structure => {
                        i: CARDINAL _ AMTypes.NameToIndex[type: tr^, name: edgeLabel];
                        ctr: TypeRef _ NEW [Type _ AMTypes.IndexToType[type: tr^, index: i]];
                        Check[[edgeLabel, edgeClass], [ctr, typeVertexClass], i];
                        };
                    ref, pointer, longPointer => ERROR;
                    definition => ERROR;
                    array, sequence, procedure => {
                        edge _ [edgeLabel, edgeClass];
                        IF edgeLabel.Equal["arg"] THEN Check[edge, NewTypeVertex[AMTypes.Domain[tr^]], 1]
                        ELSE IF edgeLabel.Equal["result"] THEN Check[edge, NewTypeVertex[AMTypes.Range[tr^]], 2]
                        ELSE Graphs.Error[BadArgs];
                        };
                    ENDCASE => ERROR;
                };
            ENDCASE => Graphs.Error[Cant];
        END;

    CountTypeNeighbors: PROC [vertex: Graphs.Vertex, filter: Graphs.DirectionFilter _ Graphs.allDirections] RETURNS [neighborCount: 
    INT] --Graphs.NeighborCountProc-- =
        BEGIN
        tr: TypeRef _ NARROW[vertex.rep];
        tc: AMTypes.Class _ AMTypes.TypeClass[tr^];
        IF filter[Incoming] THEN Graphs.Error[Cant];
        IF NOT filter[Outgoing] THEN RETURN [0];
        SELECT tc FROM
            record, structure => BEGIN
                neighborCount _ AMTypes.NComponents[tr^];
                END;
            ref, pointer, longPointer, definition => neighborCount _ 1;
            array, sequence, procedure => neighborCount _ 2;
            ENDCASE => neighborCount _ 0;
        END;

    typeVertexClass: Graphs.VertexClass _ Graphs.NewVertexClass[[
        Expand: ExpandType,
        EnumerateForLabels: EnumerateTypeLabels,
        GetNeighbor: GetNeighbor,
        GetNeighborCount: CountTypeNeighbors
        ]];

    edgeClass: Graphs.EdgeClass _ Graphs.NewEdgeClass[[GetLabel: GetEdgeLabel]];

    GetEdgeLabel: PROC [e: Graphs.Edge] RETURNS [l: Graphs.Label] = {
        l _ NARROW[e.rep];
        };

    END.