
    <<StdIntFunctions4.Mesa>>
        <<Last tweaked by Mike Spreitzer on October 16, 1987 10:43:40 am PDT>>

    DIRECTORY Basics, Collections, IntFunctions, IntStuff, PairCollections, List;

    StdIntFunctions4: CEDAR PROGRAM
        IMPORTS Collections, IntFunctions, IntStuff, PairCollections, List
        EXPORTS IntFunctions
        =

    BEGIN OPEN PCs:PairCollections, Colls:Collections, Ints:IntStuff, Collections, PairCollections, IntStuff, IntFunctions;

    AcceptAny: PUBLIC PROC [pair: IVPair] RETURNS [pass: BOOL _ FALSE] --Tester--
        ~ {RETURN [TRUE]};

    Enumerate: PUBLIC PROC [fn: IntFn, Consume: PROC [IVPair], left: Interval _ [], right: Collection _ passAll, bkwd: BOOL _ FALSE] ~ {
        Pass: PROC [pair: IVPair] RETURNS [pass: BOOL _ FALSE] ~ {Consume[pair]};
        [] _ fn.Scan[Pass, left, right, bkwd];
        };

    AddPair: PUBLIC PROC [fn: IntFn, pair: IVPair, if: IfNewsPair _ ALL[ALL[TRUE]]] RETURNS [news: NewsPair] ~ {
        some: NewsSetPair ~ fn.AddColl[CreateSingleton[pair, fn.RightSpace], if];
        news _ ALL[different];
        FOR dir: Direction IN Direction DO
            FOR n: News IN News DO
                IF some[dir][n] THEN news[dir] _ n;
                ENDLOOP;
            ENDLOOP;
        RETURN};

    refIntFns: PUBLIC Space ~ NEW [SpacePrivate _ [
        Equal: IntFnsEqual,
        Hash: HashIntFn,
        Compare: CompareIntFns,
        other: List.PutAssoc[$Name, "ref IntFns", NIL]
        ]];

    IntFnsEqual: PROC [data: REF ANY, elt1, elt2: Value] RETURNS [BOOL] ~ {
        if1: IntFn ~ DeRef[elt1];
        if2: IntFn ~ DeRef[elt2];
        RETURN Equal[if1, if2]};

    HashIntFn: PROC [data: REF ANY, elt: Value] RETURNS [CARDINAL] ~ {
        if: IntFn ~ DeRef[elt];
        RETURN Hash[if]};

    CompareIntFns: PROC [data: REF ANY, elt1, elt2: Value] RETURNS [Basics.Comparison] ~ {
        if1: IntFn ~ DeRef[elt1];
        if2: IntFn ~ DeRef[elt2];
        RETURN Compare[if1, if2]};

    Wi: PROC [i: INT] RETURNS [Value]
        ~ INLINE {RETURN [NEW [INT _ i]]};

    Wp: PROC [pair: IVPair] RETURNS [Pair]
        ~ INLINE {RETURN [[NEW [INT _ pair.left], pair.right]]};

    Wmi: PROC [mi: MaybeInt] RETURNS [MaybeValue]
        ~ INLINE {RETURN [IF mi.found THEN [TRUE, Wi[mi.i]] ELSE noMaybe]};

    Wmp: PROC [mp: MaybePair] RETURNS [PCs.MaybePair]
        ~ INLINE {RETURN [IF mp.found THEN [TRUE, Wp[mp.pair]] ELSE PCs.noMaybePair]};

    Ni: PROC [i: Value] RETURNS [INT]
        ~ INLINE {RETURN [NARROW[i, REF INT]^]};

    Np: PROC [pair: Pair] RETURNS [IVPair]
        ~ INLINE {RETURN [[Ni[pair[left]], pair[right]]]};

    Nmi: PROC [mv: MaybeValue] RETURNS [MaybeInt]
        ~ INLINE {RETURN [IF mv.found THEN [TRUE, Ni[mv.val]] ELSE noInt]};

    Nmp: PROC [mp: PCs.MaybePair] RETURNS [MaybePair]
        ~ INLINE {RETURN [IF mp.found THEN [TRUE, Np[mp.pair]] ELSE noMaybePair]};

    PashClasses: TYPE ~ ARRAY --isOneToOne--BOOL OF ARRAY --isDense--BOOL OF ARRAY --ordered--BOOL OF ARRAY Mutability OF ARRAY 
    --domainFixed--BOOL OF IntFnClass;
    pashClasses: REF PashClasses ~ NEW[PashClasses];

    CreatePartnership: PUBLIC PROC [a, b: IntFn] RETURNS [IntFn] ~ {
        p: Pash ~ NEW [PashPrivate _ [a, b]];
        RETURN [[
            pashClasses[a.IsOneToOne][a.class.isDense][a.Ordered][a.MutabilityOf][a.DomainIsFixed],
            p]]};

    Pash: TYPE ~ REF PashPrivate;
    PashPrivate: TYPE ~ RECORD [
        a, b: IntFn
        ];

    PashPrimitive: PROC [fn: IntFn, op: ATOM, args: ArgList _ NIL] RETURNS [PrimitiveAnswer] ~ {
        p: Pash ~ NARROW[fn.data];
        SELECT op FROM
            $HasPair, $Apply, $Get3, $Index, $GetBounds, $ImproveBounds, $RightCollection, $CurRange, $RightSpace => RETURN [IF 
            p.a.QualityOf[op, args]>=goodDefault THEN yes ELSE no];
            $Extremum => RETURN [IF p.a.QualityOf[op, args]>=goodDefault AND ((NOT GetBool[args, 2]) OR fn.QualityOf[$RemPair]>=goodDefault) 
            THEN yes ELSE no];
            $Scan => RETURN [IF QualityOf[(IF GetRestriction[args,1]<GetRestriction[args,2] AND (p.b.Ordered OR (NOT fn.Ordered) OR 
            (fn.IsOneToOne AND GetRestriction[args,2]=tiny)) THEN p.b ELSE p.a), op, args]>=goodDefault THEN yes ELSE no];
            $Size => RETURN [IF QualityOf[(IF GetRestriction[args,1]<GetRestriction[args,2] THEN p.b ELSE p.a), op, args]>=goodDefault THEN yes 
            ELSE no];
            $InvApply => RETURN [IF p.b.QualityOf[op, args]>=goodDefault THEN yes ELSE no];
            $Copy, $Insulate, $ValueOf, $Freeze, $Thaw, $AddColl, $RemColl, $RightDeleteColl, $ReplaceMe, $ReshapeMe, $Swap => RETURN [IF 
            p.a.Can[op, args] AND p.b.Can[op, args] THEN yes ELSE no];
            ENDCASE => RETURN [pass];
        };

    PashHasPair: PROC [fn: IntFn, pair: IVPair] RETURNS [BOOL] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.a.HasPair[pair]};

    PashApply: PROC [fn: IntFn, i: INT] RETURNS [MaybeValue] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.a.Apply[i]};

    PashInvApply: PROC [fn: IntFn, v: Value] RETURNS [MaybeInt] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.b.InvApply[v]};

    PashScan: PROC [fn: IntFn, Test: Tester, left: Interval, right: Collection, bkwd: BOOL] RETURNS [MaybePair] ~ {
        p: Pash ~ NARROW[fn.data];
        leftSize: EINT ~ left.Length;
        rightSize: EINT ~ IF right.QualityOf[$Size] >= goodDefault THEN IE[right.Size[]] ELSE maxIntervalLength;
        RETURN (IF leftSize.Compare[rightSize]=greater AND (p.b.Ordered OR (NOT fn.Ordered) OR (fn.IsOneToOne AND 
        rightSize.Compare[one]<=equal)) THEN p.b ELSE p.a).Scan[Test, left, right, bkwd]};

    PashExtremum: PROC [fn: IntFn, bkwd, remove: BOOL] RETURNS [mp: MaybePair] ~ {
        p: Pash ~ NARROW[fn.data];
        mp _ p.a.Extremum[bkwd, FALSE];
        IF mp.found AND remove THEN {
            had: BoolPair ~ fn.RemPair[mp.pair];
            IF (NOT had[leftToRight]) OR (fn.IsOneToOne[] AND NOT had[rightToLeft]) THEN ERROR;
            };
        RETURN};

    PashGet3: PROC [fn: IntFn, pair: IVPair] RETURNS [prev, same, next: MaybePair] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.a.Get3[pair]};

    PashIndex: PROC [fn, goal: IntFn, bounds: Interval, bkwd: BOOL] RETURNS [MaybeInt] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.a.Index[goal, bounds, bkwd]};

    PashSize: PROC [fn: IntFn, left: Interval, right: Collection, limit: LNAT] RETURNS [LNAT] ~ {
        p: Pash ~ NARROW[fn.data];
        leftSize: EINT ~ left.Length;
        rightSize: EINT ~ IF right.QualityOf[$Size] >= goodDefault THEN IE[right.Size[]] ELSE maxIntervalLength;
        RETURN (IF leftSize.Compare[rightSize]=greater THEN p.b ELSE p.a).Size[left, right, limit]};

    PashGetBounds: PROC [fn: IntFn] RETURNS [Interval] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.a.GetBounds[]};

    PashImproveBounds: PROC [fn: IntFn, bounds: Interval] RETURNS [Interval] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.a.ImproveBounds[bounds]};

    PashCopy: PROC [fn: IntFn] RETURNS [VarIntFn] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN CreatePartnership[p.a.Copy, p.b.Copy].AsVar};

    PashInsulate: PROC [fn: IntFn] RETURNS [UWIntFn] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN CreatePartnership[p.a.Insulate, p.b.Insulate].AsUW};

    PashValueOf: PROC [fn: IntFn] RETURNS [ConstIntFn] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN CreatePartnership[p.a.ValueOf, p.b.ValueOf].AsConst};

    PashFreeze: PROC [fn: IntFn] RETURNS [ConstIntFn] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN CreatePartnership[p.a.Freeze, p.b.Freeze].AsConst};

    PashThaw: PROC [fn: IntFn] ~ {
        p: Pash ~ NARROW[fn.data];
        p.a.Thaw[];
        p.b.Thaw[];
        RETURN};

    PashAddColl: PROC [fn, other: IntFn, if: IfNewsPair] RETURNS [some: NewsSetPair] ~ {
        p: Pash ~ NARROW[fn.data];
        some _ [
            leftToRight: p.a.AddColl[other, if].some[leftToRight],
            rightToLeft: p.b.AddColl[other, if].some[rightToLeft]];
        RETURN};

    PashRemColl: PROC [fn, other: IntFn] RETURNS [hadSome, hadAll: BoolPair] ~ {
        p: Pash ~ NARROW[fn.data];
        o2: IntFn ~ IF other=fn THEN p.b ELSE other;
        sum, all: BoolPair;
        [hadSome, hadAll] _ p.a.RemColl[other];
        [sum, all] _ p.a.RemColl[o2];
        hadSome[rightToLeft] _ sum[rightToLeft];
        hadAll[rightToLeft] _ all[rightToLeft];
        RETURN};

    PashRightDeleteColl: PROC [fn: IntFn, coll: Collection, style: RemoveStyle] RETURNS [hadSome, hadAll: BOOL] ~ {
        p: Pash ~ NARROW[fn.data];
        sum, all: BOOL;
        [hadSome, hadAll] _ p.a.RightDeleteColl[coll, style];
        [sum, all] _ p.b.RightDeleteColl[coll, style];
        IF sum#hadSome OR all#hadAll THEN ERROR;
        RETURN};

    PashReplaceMe: PROC [fn, with: IntFn, where, clip: Interval] RETURNS [losses, gains: EINT] ~ {
        p: Pash ~ NARROW[fn.data];
        l2, g2: EINT;
        TRUSTED {
            [losses, gains] _ p.a.ReplaceMe[with, where, clip];
            [l2, g2] _ p.b.ReplaceMe[with, where, clip]};
        IF l2#losses OR g2#gains THEN ERROR;
        RETURN};

    PashReshapeMe: PROC [fn: IntFn, lt: XForm, lb: Interval, rt: OneToOne, rb: Collection] ~ {
        p: Pash ~ NARROW[fn.data];
        p.a.ReshapeMe[lt, lb, rt, rb];
        p.b.ReshapeMe[lt, lb, rt, rb];
        RETURN};

    PashSwap: PROC [fn: IntFn, i, j: INT] ~ {
        p: Pash ~ NARROW[fn.data];
        p.a.Swap[i, j];
        p.b.Swap[i, j];
        RETURN};

    PashRightCollection: PROC [fn: IntFn] RETURNS [UWColl] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.a.RightCollection[]};

    PashCurRange: PROC [fn: IntFn] RETURNS [ConstSet] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.a.CurRange[]};

    PashRightSpace: PROC [fn: IntFn] RETURNS [Space] ~ {
        p: Pash ~ NARROW[fn.data];
        RETURN p.a.RightSpace[]};

    Start: PROC ~ {
        FOR isOneToOne: BOOL IN BOOL DO FOR ordered: BOOL IN BOOL DO FOR isDense: BOOL IN BOOL DO FOR domainFixed: BOOL IN BOOL DO
            pashClasses[isOneToOne][isDense][ordered][constant][domainFixed] _ CreateClass[[
                Primitive: PashPrimitive,
                HasPair: PashHasPair,
                Apply: PashApply,
                InvApply: PashInvApply,
                Scan: PashScan,
                Extremum: PashExtremum,
                Get3: PashGet3,
                Index: PashIndex,
                Size: PashSize,
                GetBounds: PashGetBounds,
                ImproveBounds: PashImproveBounds,
                Copy: PashCopy,
                RightCollection: PashRightCollection,
                CurRange: PashCurRange,
                RightSpace: PashRightSpace,
                isOneToOne: isOneToOne,
                isDense: isDense,
                ordered: ordered,
                mutability: constant,
                domainFixed: domainFixed
                ]];
            pashClasses[isOneToOne][isDense][ordered][readonly][domainFixed] _ CreateClass[[
                Primitive: PashPrimitive,
                HasPair: PashHasPair,
                Apply: PashApply,
                InvApply: PashInvApply,
                Scan: PashScan,
                Extremum: PashExtremum,
                Get3: PashGet3,
                Index: PashIndex,
                Size: PashSize,
                GetBounds: PashGetBounds,
                ImproveBounds: PashImproveBounds,
                Copy: PashCopy,
                ValueOf: PashValueOf,
                RightCollection: PashRightCollection,
                CurRange: PashCurRange,
                RightSpace: PashRightSpace,
                isOneToOne: isOneToOne,
                isDense: isDense,
                ordered: ordered,
                mutability: readonly,
                domainFixed: domainFixed
                ]];
            pashClasses[isOneToOne][isDense][ordered][variable][domainFixed] _ CreateClass[[
                Primitive: PashPrimitive,
                HasPair: PashHasPair,
                Apply: PashApply,
                InvApply: PashInvApply,
                Scan: PashScan,
                Extremum: PashExtremum,
                Get3: PashGet3,
                Index: PashIndex,
                Size: PashSize,
                GetBounds: PashGetBounds,
                ImproveBounds: PashImproveBounds,
                Copy: PashCopy,
                Insulate: PashInsulate,
                ValueOf: PashValueOf,
                Freeze: PashFreeze,
                Thaw: PashThaw,
                AddColl: PashAddColl,
                RemColl: PashRemColl,
                RightDeleteColl: PashRightDeleteColl,
                ReplaceMe: PashReplaceMe,
                ReshapeMe: PashReshapeMe,
                Swap: PashSwap,
                RightCollection: PashRightCollection,
                CurRange: PashCurRange,
                RightSpace: PashRightSpace,
                isOneToOne: isOneToOne,
                isDense: isDense,
                ordered: ordered,
                mutability: variable,
                domainFixed: domainFixed
                ]];
            ENDLOOP ENDLOOP ENDLOOP ENDLOOP;
        };

    Start[];

    END.