
    <<SiroccoGraphObjectsImpl.Mesa>>
        <<Copyright Ó 1986, 1987 by Xerox Corporation.  All rights reserved.>>
        <<Bhargava, August 9, 1986 2:56:46 pm PDT>>
        <<Demers, December 29, 1986 9:48:13 pm PST>>
        <<Bill Jackson (bj) August 27, 1987 0:51:34 am PDT>>

    DIRECTORY
        RefTab USING [ Create, Ref ],
        Rope USING [ ROPE ],
        SiroccoBaseDef USING [ ItemFromContext ],
        SiroccoCGDef USING [ BaseTypeKind, Generic, ItemKind, ValueKind ],
        SiroccoPrivate USING [ AbstractValue, AbstractValueObject, CONTEXT, GraphRep, ITEM, ItemRep, NodeRep, TypeGraph, TypeGraphNode ],
        SiroccoPrivateTypes;

    SiroccoGraphObjectsImpl: CEDAR PROGRAM
        IMPORTS SiroccoBaseDef, RefTab
        EXPORTS SiroccoBaseDef ~ {
        OPEN SiroccoBaseDef, SiroccoCGDef, SiroccoPrivate, SiroccoPrivateTypes;
        ROPE: TYPE ~ Rope.ROPE;
    <<Type Graph/Node Creators>>
        <<internal for now!>>
        MakeItem: PUBLIC PROC [ name: ROPE, position: INT, kind: SiroccoCGDef.ItemKind ]
        RETURNS [ item: ITEM _ NIL ] ~ {
        type: TypeGraphNode ~ NEW [NodeRep _ [specifics: NIL]];
        value: AbstractValue ~ CreateIndirectAVN[NIL];
            item _ NEW [ItemRep _
            [ name: name, position: position, kind: kind, type: type, value: value, state: unvisited ]];
            };
    <<Primitive Creators>>
        CreateEmptyTGN: PUBLIC PROC [ context: CONTEXT ]
        RETURNS [ new: TypeGraph _ NIL ] ~ {
            reftab: RefTab.Ref ~ RefTab.Create[];
            new _ NEW [GraphRep _ [context: context, reftab: reftab]];
            };
        CreatePrimitiveTGN: PUBLIC PROC [ class: Generic ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            node _ NEW [NodeRep _ [class: class] ];
            };
    <<Primary Creators>>
        CreateArrayTGN: PUBLIC PROC [ length: AbstractValue, subtype: TypeGraphNode ] RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            atgn: ArrayTGN ~ NEW [ArrayTGNBody _ [length: length, itemType: subtype]];
            node _ atgn;
            };
        CreateBaseTypeTGN: PUBLIC PROC [ kind: BaseTypeKind ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            btgn: BaseTypeTGN ~ NEW [BaseTypeTGNBody _ [type: kind]];
            node _ btgn;
            };
        CreateChoiceTGN: PUBLIC PROC [ ktype: TypeGraphNode, union: TypeGraphNode]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            ctgn: ChoiceTGN ~ NEW [ChoiceTGNBody _ [ktype: ktype, union: union]];
            node _ ctgn;
            };
        CreateDerefTGN: PUBLIC PROC [ context: CONTEXT, item: ROPE ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            referent: TypeGraphNode ~ ItemFromContext[context, item].type; 
            tgn: DerefTGN ~ NEW [DerefTGNBody _ [item: item, type: referent]];
            node _ tgn;
            };
        CreateEnumerationTGN: PUBLIC PROC [ enum: TypeGraphNode ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            etgn: EnumTGN ~ NEW [EnumTGNBody _ [enum: enum]];
            node _ etgn;
            };
        CreateErrorTGN: PUBLIC PROC [ fieldlist: TypeGraphNode ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            etgn: ErrorTGN ~ NEW [ErrorTGNBody _ [fieldlist: fieldlist]];
            node _ etgn
            };
        CreateLinkTGN: PUBLIC PROC [ context: CONTEXT, interface: ROPE, item: ROPE ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            imports: CONTEXT ~ context; -- RemoteContext[context, interface];
            referent: TypeGraphNode ~ ItemFromContext[imports, item].type;
            tgn: LinkTGN ~ NEW [LinkTGNBody _ [tgn: referent, interface: interface, item: item]];
            node _ tgn;
            };
        CreateProcTGN: PUBLIC PROC [ args: TypeGraphNode, results: TypeGraphNode,
        errors: TypeGraphNode ] RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            ptgn: ProcTGN ~ NEW [ProcTGNBody _ [args: args, results: results, errors: errors]];
            node _ ptgn;
            };
        CreateRecordTGN: PUBLIC PROC [ fieldlist: TypeGraphNode ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            rtgn: RecordTGN ~ NEW [RecordTGNBody _ [fieldlist: fieldlist]];
            node _ rtgn;
            };
        CreateSequenceTGN: PUBLIC PROC [ maxlength: AbstractValue,
        subtype: TypeGraphNode ] RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            stgn: SequenceTGN ~ NEW [SequenceTGNBody _ [maxlength: maxlength,
            subtype: subtype]];
            node _ stgn;
            };
    <<Secondary Creators>>
        CreateFieldListTGN: PUBLIC PROC [ tag: ROPE, ordinal: AbstractValue ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            fltgn: FieldListTGN ~ NEW [FieldListTGNBody _ [tag: tag, ordinal: ordinal]];
            node _ fltgn;
            };
        CreateUnionTGN: PUBLIC PROC [ namelist: TypeGraphNode, type: TypeGraphNode ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            utgn: UnionTGN ~ NEW [UnionTGNBody _ [namelist: namelist, type: type]];
            node _ utgn;
            };
        CreateFieldTGN: PUBLIC PROC [ namelist: TypeGraphNode, type: TypeGraphNode ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            ftgn: FieldTGN ~ NEW [FieldTGNBody _ [namelist: namelist, type: type]];
            node _ ftgn;
            };
        CreateEmptyFieldTGN: PUBLIC PROC [ ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            node _ CreateFieldTGN[NIL, NIL];
            };
    <<Concatination operators>>
        FieldListTGNConcat: PUBLIC PROC [ value: TypeGraphNode, next: TypeGraphNode ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            tgn: HackTGN ~ NEW [HackTGNBody _ [value: value, next: next]];
            node _ tgn;
            };
        UnionTGNConcat: PUBLIC PROC [ value: TypeGraphNode, next: TypeGraphNode ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            tgn: HackTGN ~ NEW [HackTGNBody _ [value: value, next: next]];
            node _ tgn;
            };
        FieldTGNConcat: PUBLIC PROC [ value: TypeGraphNode, next: TypeGraphNode ]
        RETURNS [ node: TypeGraphNode _ NIL ] ~ {
            tgn: HackTGN ~ NEW [HackTGNBody _ [value: value, next: next]];
            node _ tgn;
            };
    <<Abstract Value Node Creators>>
        <<internal for now!>>
        CreateIndirectAVN: PUBLIC PROC [ specifics: REF ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            new: REF AbstractValueObject ~ NEW [AbstractValueObject _
            [ kind: indirect, specifics: specifics ]];
            value _ new;
            };
    <<Primary Creators>>
        CreateNullAVN: PUBLIC PROC [ ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            };

        CreateLogicalAVN: PUBLIC PROC [ b: BOOLEAN ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            avn: LogicalAVN ~ NEW [LogicalAVNBody _ [value: b]];
            value _ avn;
            };
        CreateNumericalAVN: PUBLIC PROC [ num: CARD ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            avn: NumericalAVN ~ NEW [NumericalAVNBody _
            [inverted: FALSE, value: num]];
            value _ avn;
            };
        CreateRopeAVN: PUBLIC PROC [ r1: ROPE ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            avn: RopeAVN ~ NEW [RopeAVNBody _ [value: r1]];
            value _ avn;
            };
    <<Secondary Creators>>
        CreateBindingAVN: PUBLIC PROC [ tgn: TypeGraphNode, node: AbstractValue ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            avn: BindingAVN ~ NEW [BindingAVNBody _
            [ tgn: tgn, node: node ]];
            value _ avn;
            };
        CreateConstructorAVN: PUBLIC PROC [ node: AbstractValue ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            avn: ConstructorAVN ~ NEW [ConstructorAVNBody _ [ node: node ]];
            value _ avn;
            };
        CreateDerefAVN: PUBLIC PROC [ context: CONTEXT, item: ROPE ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            referent: AbstractValue ~ ItemFromContext[context, item].value;
            avn: DerefAVN ~ NEW [DerefAVNBody _ [item: item, value: referent]];
            value _ avn;
            };
        CreateGroupingAVN: PUBLIC PROC [ node: AbstractValue ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            avn: GroupingAVN ~ NEW [GroupingAVNBody _ [ node: node ]];
            value _ avn;
            };
        CreateLinkAVN: PUBLIC PROC [ context: CONTEXT, interface: ROPE, item: ROPE ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            imports: CONTEXT ~ context; -- RemoteContext[context, interface];
            referent: AbstractValue ~ ItemFromContext[imports, item].value;
            avn: LinkAVN ~ NEW [LinkAVNBody _ [avn: referent, interface: interface, item: item]];
            value _ avn;
            };
        CreateNegativeAVN: PUBLIC PROC [ old: AbstractValue ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            child: NumericalAVN ~ NARROW[old];
            avn: NumericalAVN ~ NEW [NumericalAVNBody _
            [inverted: ( NOT child.inverted ), value: child.value]];
            value _ avn;
            };
        CreateVariantAVN: PUBLIC PROC [ id: ROPE, node: AbstractValue ]
        RETURNS [ value: AbstractValue _ NIL ] ~ {
            avn: VariantAVN ~ NEW [VariantAVNBody _ [ id: id, node: node ]];
            value _ avn;
            };

        ConstructorAVNConcat: PUBLIC PROC [ value: AbstractValue, next: AbstractValue ]
        RETURNS [ node: AbstractValue _ NIL ] ~ {
            tgn: HackAVN ~ NEW [HackAVNBody _ [value: value, next: next]];
            node _ tgn;
            };
        GroupingAVNConcat: PUBLIC PROC [ value: AbstractValue, next: AbstractValue ]
        RETURNS [ node: AbstractValue _ NIL ] ~ {
            tgn: HackAVN ~ NEW [HackAVNBody _ [value: value, next: next]];
            node _ tgn;
            };
    <<Error Handling>>
        Something: SIGNAL ~ CODE;

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

        }.