
    <<BiRelsAsSets.Mesa>>
        <<Last tweaked by Mike Spreitzer on December 14, 1987 11:52:03 am PST>>

    DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, SetBasics;

    BiRelsAsSets: CEDAR PROGRAM
        IMPORTS AbSets, BiRelBasics, BiRels, SetBasics
        EXPORTS BiRels
        =

    BEGIN OPEN SetBasics, BiRelBasics, BiRels, Sets:AbSets, Sets;

    Widening: TYPE ~ REF WideningPrivate;
    WideningPrivate: TYPE ~ RECORD [br: BiRel, ro, rro: BiRels.TotalRelOrder];

    DefaultAsSet: PUBLIC PROC [br: BiRel, ro: BiRels.RelOrder] RETURNS [Set--of REF Pair--] ~ {
        ro _ CanonizeRelOrder[ro, br.Functional[]];
        FOR s: Side IN Side DO IF ro.sub[s]=no THEN ro.sub[s] _ fwd ENDLOOP;
        {w: Widening ~ NEW [WideningPrivate _ [br, ro, ro.ReverseRO[]]];
        RETURN [[wideClasses[br.MutabilityOf[]], [a[w]] ]]}};

    WideClasses: TYPE ~ ARRAY Mutability OF SetClass;
    wideClasses: REF WideClasses ~ NEW [WideClasses];

    WidePrimitive: PROC [set: Set, op: ATOM, arg1, arg2: REF ANY] RETURNS [PrimitiveAnswer] ~ {
        w: Widening ~ NARROW[set.data.VA];
        SELECT op FROM
            $HasMember, $QuaBiRel, $QuaIntInterval => RETURN [yes];
            $Scan => RETURN [IF w.br.Can[op] THEN yes ELSE no];
            $Size, $Copy, $Insulate, $ValueOf, $Freeze, $Thaw, $GetOne => RETURN [IF w.br.Can[op, arg1] THEN yes ELSE no];
            $Get3 => RETURN [IF w.br.Can[$Get3, BiRels.FromRO[[ALL[fwd]]]] THEN yes ELSE no];
            $GetBounds => {
                want: EndBools ~ ToEB[arg1];
                RETURN [IF w.br.Can[$GetBounds, FromEB[want], BiRels.FromRO[w.ro]] THEN yes ELSE no]};
            $AddSet, $RemSet => {other: Set ~ DeRef[arg1];
                obr: BiRel ~ SetAsBiRel[other];
                RETURN [IF w.br.Can[op, obr.Refify] THEN yes ELSE no]};
            ENDCASE => RETURN [pass];
        };

    WideHasMember: PROC [set: Set, elt: Value] RETURNS [BOOL] ~ {
        w: Widening ~ NARROW[set.data.VA];
        RETURN w.br.HasPair[Nv[elt]]};

    WideScan: PROC [set: Set, Test: Tester, ro: RelOrder] RETURNS [MaybeValue] ~ {
        w: Widening ~ NARROW[set.data.VA];
        Pass: PROC [pair: Pair] RETURNS [BOOL] --BiRels.Tester-- ~ {RETURN Test[Wp[pair]]};
        RETURN Wmp[w.br.Scan[Pass, Nro[w, ro]]]};

    WideGetOne: PROC [set: Set, remove: BOOL, ro: RelOrder] RETURNS [MaybeValue] ~ {
        w: Widening ~ NARROW[set.data.VA];
        RETURN Wmp[w.br.GetOne[remove, Nro[w, ro]]]};

    WideGet3: PROC [set: Set, elt: Value, want: TripleBool] RETURNS [TripleMaybeValue] ~ {
        w: Widening ~ NARROW[set.data.VA];
        tmp: TripleMaybePair ~ w.br.Get3[Nv[elt], w.ro, want];
        RETURN [[Wmp[tmp.prev], Wmp[tmp.same], Wmp[tmp.next]]]};

    WideSize: PROC [set: Set, limit: EINT] RETURNS [EINT] ~ {
        w: Widening ~ NARROW[set.data.VA];
        RETURN w.br.Size[limit]};

    WideGetBounds: PROC [set: Set, want: EndBools] RETURNS [MaybeInterval] ~ {
        w: Widening ~ NARROW[set.data.VA];
        mpi: MaybePairInterval ~ w.br.GetBounds[want, w.ro];
        IF NOT mpi.found THEN RETURN [[FALSE, []]];
        RETURN [[TRUE, [Wp[mpi.it[min]], Wp[mpi.it[max]]]]]};

    WideCopy: PROC [set: Set] RETURNS [VarSet] ~ {
        w: Widening ~ NARROW[set.data.VA];
        RETURN w.br.Copy.AsSet[w.ro].AsVar};

    WideInsulate: PROC [set: Set] RETURNS [UWSet] ~ {
        w: Widening ~ NARROW[set.data.VA];
        RETURN w.br.Insulate.AsSet[w.ro].AsUW};

    WideValueOf: PROC [set: Set] RETURNS [ConstSet] ~ {
        w: Widening ~ NARROW[set.data.VA];
        RETURN w.br.ValueOf.AsSet[w.ro].AsConst};

    WideFreeze: PROC [set: Set] RETURNS [ConstSet] ~ {
        w: Widening ~ NARROW[set.data.VA];
        RETURN w.br.Freeze.AsSet[w.ro].AsConst};

    WideThaw: PROC [set: Set] ~ {
        w: Widening ~ NARROW[set.data.VA];
        w.br.Thaw[];
        RETURN};

    WideAddSet: PROC [set, other: Set] RETURNS [new: SomeAll _ []] ~ {
        w: Widening ~ NARROW[set.data.VA];
        fnl: BoolPair ~ w.br.Functional[];
        IF fnl # ALL[FALSE] THEN {
            obr: BiRel ~ SetAsBiRel[other];
            some: HadSetPair ~ w.br.AddSet[obr];
            dir: Direction ~ IF fnl[leftToRight] THEN leftToRight ELSE rightToLeft;
            RETURN [[some: some[dir][none] OR some[dir][different], all: NOT some[dir][same]]];
            }
        ELSE {
            Addit: PROC [val: Value] ~ {
                pair: Pair ~ Nv[val];
                IF w.br.HasPair[pair] THEN new.all _ FALSE ELSE new.some _ TRUE;
                [] _ w.br.AddPair[pair];
                RETURN};
            other.Enumerate[Addit];
            RETURN};
        };

    WideRemSet: PROC [set, other: Set] RETURNS [had: SomeAll _ []] ~ {
        w: Widening ~ NARROW[set.data.VA];
        fnl: BoolPair ~ w.br.Functional[];
        IF fnl # ALL[FALSE] THEN {
            obr: BiRel ~ SetAsBiRel[other];
            dir: Direction ~ IF fnl[leftToRight] THEN leftToRight ELSE rightToLeft;
            some: HadSetPair ~ w.br.RemSet[obr];
            RETURN [[some: some[dir][same], all: NOT (some[dir][none] OR some[dir][different])]];
            }
        ELSE {
            Remit: PROC [val: Value] ~ {
                pair: Pair ~ Nv[val];
                IF w.br.HasPair[pair] THEN had.some _ TRUE ELSE had.all _ FALSE;
                [] _ w.br.RemPair[pair];
                RETURN};
            other.Enumerate[Remit];
            RETURN};
        };

    WideQuaBiRel: PROC [set: Set] RETURNS [found: BOOL, class, data: REF ANY] ~ {
        w: Widening ~ NARROW[set.data.VA];
        RETURN [TRUE, w.br.class, w.br.data]};

    WideQuaIntInterval: PROC [set: Set] RETURNS [MaybeIntInterval] ~ {
        RETURN [[FALSE, []]]};

    WideSpaceOf: PROC [set: Set] RETURNS [Space] ~ {
        w: Widening ~ NARROW[set.data.VA];
        RETURN WidenPairSpace[[w.br.Spaces[], w.ro]]};

    Nv: PROC [v: Value] RETURNS [Pair]
        ~ INLINE {RETURN [NARROW[v.VA, REF Pair]^]};

    Wp: PROC [p: Pair] RETURNS [Value]
        ~ INLINE {RETURN [[a[NEW [Pair _ p]]]]};

    Wmp: PROC [mp: MaybePair] RETURNS [MaybeValue]
        ~ INLINE {RETURN [IF mp.found THEN [TRUE, Wp[mp.it]] ELSE noMaybe]};

    Nro: PROC [w: Widening, ro: RelOrder] RETURNS [BiRels.RelOrder]
        ~ INLINE {RETURN [SELECT ro FROM
            no => [],
            fwd => w.ro,
            bwd => w.rro,
            ENDCASE => ERROR]};

    Start: PROC ~ {
        FOR mut: Mutability IN Mutability DO
            wideClasses[mut] _ CreateClass[[
                Primitive: WidePrimitive,
                HasMember: WideHasMember,
                Scan: WideScan,
                GetOne: WideGetOne,
                Get3: WideGet3,
                Size: WideSize,
                GetBounds: WideGetBounds,
                Copy: WideCopy,
                Insulate: IF mut=variable THEN WideInsulate ELSE NIL,
                ValueOf: IF mut#constant THEN WideValueOf ELSE NIL,
                Freeze: IF mut=variable THEN WideFreeze ELSE NIL,
                Thaw: IF mut=variable THEN WideThaw ELSE NIL,
                AddSet: IF mut=variable THEN WideAddSet ELSE NIL,
                RemSet: IF mut=variable THEN WideRemSet ELSE NIL,
                QuaBiRel: WideQuaBiRel,
                QuaIntInterval: WideQuaIntInterval,
                SpaceOf: WideSpaceOf,
                mutability: mut]];
            ENDLOOP;
        RETURN};

    Start[];

    END.