
    <<StdIntFunctions7.Mesa>>
        <<Last tweaked by Mike Spreitzer on October 19, 1987 1:47:15 pm PDT>>

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

    StdIntFunctions7: CEDAR PROGRAM
        IMPORTS Collections, IntFunctions, PairCollections
        EXPORTS IntFunctions
        =

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

    Compose: PUBLIC PROC [left: IntFn, right: Function, leftRestricts, rightRestricts: BOOL _ TRUE] RETURNS [IntFn] ~ {
        oneToOne: BOOL ~ left.IsOneToOne AND right.Functional[][rightToLeft];
        isDense: BOOL ~ left.class.isDense AND NOT rightRestricts;
        ordered: BOOL ~ left.Ordered;
        mutability: UnwriteableMutability ~ IF left.MutabilityOf=constant AND right.MutabilityOf=constant THEN constant ELSE readonly;
        domainFixed: BOOL ~ left.DomainIsFixed;
        canSizeLeft: BOOL ~ NOT rightRestricts;
        canSizeRight: BOOL ~ left.IsOneToOne AND NOT leftRestricts;
        comp: Comp ~ NEW [CompPrivate _ [
            left, right,
            leftRestricts, rightRestricts,
            canSizeLeft, canSizeRight,
            IF oneToOne AND right.QualityOf[$Apply, LIST[$rightToLeft]]>left.QualityOf[$Apply] THEN rightToLeft ELSE leftToRight
            ]];
        RETURN [[
            compClasses
                [oneToOne]
                [isDense]
                [ordered]
                [mutability]
                [domainFixed]
                [leftRestricts]
                [rightRestricts]
                [comp.canSizeLeft OR comp.canSizeRight],
            comp]];
        };

    Classes: TYPE ~ ARRAY --oneToOne--BOOL OF ARRAY --isDense--BOOL OF ARRAY --ordered--BOOL OF ARRAY UnwriteableMutability OF ARRAY 
    --domainFixed--BOOL OF ARRAY --leftRestricts--BOOL OF ARRAY --rightRestricts--BOOL OF ARRAY --canSize--BOOL OF IntFnClass;
    compClasses: REF Classes ~ NEW[Classes];

    Comp: TYPE ~ REF CompPrivate;
    CompPrivate: TYPE ~ RECORD [
        left: IntFn,
        right: PairColl,
        leftRestricts, rightRestricts, canSizeLeft, canSizeRight: BOOL,
        applyDir: Direction
        ];

    CompPrimitive: PROC [fn: IntFn, op: ATOM, args: ArgList _ NIL] RETURNS [PrimitiveAnswer] ~ {
        comp: Comp ~ NARROW[fn.data];
        SELECT op FROM
            $Widen => RETURN [IF comp.left.Can[op, args] THEN yes ELSE no];
            $HasPair => RETURN [SELECT comp.applyDir FROM
                leftToRight => IF comp.left.QualityOf[$Apply]>=goodDefault AND comp.right.QualityOf[$HasPair]>=goodDefault THEN yes ELSE no,
                rightToLeft => IF comp.right.QualityOf[$Apply, LIST[$rightToLeft]]>=goodDefault AND comp.left.QualityOf[$HasPair]>=goodDefault THEN 
                yes ELSE no,
                ENDCASE => ERROR];
            $Apply => RETURN [IF comp.left.QualityOf[op, args]>=goodDefault AND comp.right.QualityOf[op, args]>=goodDefault THEN yes ELSE no];
            $InvApply => RETURN [IF comp.left.QualityOf[op, args]>=goodDefault AND comp.right.QualityOf[$Apply, 
            LIST[$rightToLeft]]>=goodDefault THEN yes ELSE no];
            $Scan => RETURN [IF comp.left.Can[$Scan] AND comp.right.Can[$Apply] THEN yes ELSE no];
            $Extremum => RETURN [IF GetBool[args, 2] OR (comp.left.QualityOf[op, args]>=goodDefault AND 
            comp.right.QualityOf[$Apply]>=goodDefault AND NOT comp.rightRestricts) THEN yes ELSE no];
            $Get3 => RETURN [IF comp.left.QualityOf[op, args]>=goodDefault AND comp.right.QualityOf[$Apply]>=goodDefault AND NOT 
            comp.rightRestricts THEN yes ELSE no];
            $Size => RETURN [
                IF comp.canSizeLeft AND GetRestriction[args, 2]=tiny AND comp.left.QualityOf[op, args]>=goodDefault THEN yes
                ELSE IF comp.canSizeRight AND GetRestriction[args, 1]=tiny AND GetRestriction[args, 2]=tiny AND 
                comp.right.QualityOf[op]>=goodDefault THEN yes
                ELSE no];
            $GetBounds => RETURN [IF comp.left.QualityOf[op, args]>=goodDefault AND NOT comp.rightRestricts THEN yes ELSE no];
            $ValueOf => RETURN [IF comp.left.Can[op, args] AND comp.right.Can[op, args] THEN yes ELSE no];
            $RightCollection, $CurRange => RETURN [IF comp.right.QualityOf[op, args]>=goodDefault AND NOT comp.leftRestricts THEN yes ELSE no];
            $RightSpace => RETURN [IF comp.right.Can[op, args] THEN yes ELSE no];
            ENDCASE => RETURN [pass];
        };

    CompWiden: PROC [fn: IntFn] RETURNS [Function--[left]: REF INT--] ~ {
        comp: Comp ~ NARROW[fn.data];
        RETURN PCs.Compose[[comp.left.Widen, comp.right], [comp.leftRestricts, comp.rightRestricts]]};

    CompHasPair: PROC [fn: IntFn, pair: IVPair] RETURNS [BOOL] ~ {
        comp: Comp ~ NARROW[fn.data];
        SELECT comp.applyDir FROM
            leftToRight => {
                mv: MaybeValue ~ comp.left.Apply[pair.left];
                RETURN [mv.found AND comp.right.HasPair[[mv.val, pair.right]]]};
            rightToLeft => {
                mv: MaybeValue ~ comp.right.Apply[pair.right, rightToLeft];
                RETURN [mv.found AND comp.left.HasPair[[pair.left, mv.val]]];
                };
            ENDCASE => ERROR;
        };

    CompApply: PROC [fn: IntFn, i: INT] RETURNS [MaybeValue] ~ {
        comp: Comp ~ NARROW[fn.data];
        mv: MaybeValue ~ comp.left.Apply[i];
        IF NOT mv.found THEN RETURN [mv];
        RETURN comp.right.Apply[mv.val]};

    CompInvApply: PROC [fn: IntFn, v: Value] RETURNS [MaybeInt] ~ {
        comp: Comp ~ NARROW[fn.data];
        mv: MaybeValue ~ comp.right.Apply[v, rightToLeft];
        IF NOT mv.found THEN RETURN [noInt];
        RETURN comp.left.InvApply[mv.val]};

    CompScan: PROC [fn: IntFn, Test: Tester, left: Interval, right: Collection, bkwd: BOOL] RETURNS [mp: MaybePair _ noMaybePair] ~ {
        comp: Comp ~ NARROW[fn.data];
        Pass: PROC [pair: IVPair] RETURNS [pass: BOOL] ~ {
            mv: MaybeValue ~ comp.right.Apply[pair.right];
            IF (pass _ mv.found AND right.HasMember[mv.val] AND Test[[pair.left, mv.val]]) THEN mp _ [TRUE, [pair.left, mv.val]];
            RETURN};
        [] _ comp.left.Scan[Test: Pass, left: left, bkwd: bkwd];
        RETURN};

    Complete: PROC [comp: Comp, mp: MaybePair] RETURNS [MaybePair] ~ {
        IF NOT mp.found THEN RETURN [mp];
        mp.pair.right _ comp.right.Apply[mp.pair.right].Val;
        RETURN [mp]};

    CompExtremum: PROC [fn: IntFn, bkwd, remove: BOOL] RETURNS [MaybePair] ~ {
        comp: Comp ~ NARROW[fn.data];
        IF remove THEN fn.Complain[notVariable];
    RETURN Complete[comp, comp.left.Extremum[bkwd, remove]]};

    CompGet3: PROC [fn: IntFn, pair: IVPair] RETURNS [prev, same, next: MaybePair] ~ {
        comp: Comp ~ NARROW[fn.data];
        [prev, same, next] _ comp.left.Get3[pair];
        prev _ Complete[comp, prev];
        same _ Complete[comp, same];
        next _ Complete[comp, next];
        RETURN};

    CompSize: PROC [fn: IntFn, left: Interval _ [], right: Collection _ passAll, limit: LNAT] RETURNS [LNAT] ~ {
        comp: Comp ~ NARROW[fn.data];
        IF comp.canSizeLeft AND right=passAll THEN RETURN comp.left.Size[left, right, limit];
        IF comp.canSizeRight AND left=[] AND right=passAll THEN RETURN comp.right.Size[limit];
        RETURN DefaultSize[fn, left, right, limit]};

    CompGetBounds: PROC [fn: IntFn] RETURNS [Interval] ~ {
        comp: Comp ~ NARROW[fn.data];
        RETURN comp.left.GetBounds};

    CompCopy: PROC [fn: IntFn] RETURNS [VarIntFn] ~ {
        comp: Comp ~ NARROW[fn.data];
        RETURN comp.left.Copy.Compose[comp.right.Copy, comp.leftRestricts, comp.rightRestricts].AsVar};

    CompInsulate: PROC [fn: IntFn] RETURNS [UWIntFn] ~ {
        comp: Comp ~ NARROW[fn.data];
        RETURN comp.left.Insulate.Compose[comp.right.Insulate, comp.leftRestricts, comp.rightRestricts].AsUW};

    CompValueOf: PROC [fn: IntFn] RETURNS [ConstIntFn] ~ {
        comp: Comp ~ NARROW[fn.data];
        RETURN comp.left.ValueOf.Compose[comp.right.ValueOf, comp.leftRestricts, comp.rightRestricts].AsConst};

    CompFreeze: PROC [fn: IntFn] RETURNS [const: ConstIntFn] ~ {
        comp: Comp ~ NARROW[fn.data];
        left: IntFn ~ IF comp.left.MutabilityOf#constant THEN comp.left.Freeze ELSE comp.left;
        right: PairColl ~ IF comp.right.MutabilityOf#constant THEN comp.right.Freeze ELSE comp.right;
        RETURN left.Compose[right, comp.leftRestricts, comp.rightRestricts].AsConst};

    CompThaw: PROC [fn: IntFn] ~ {
        comp: Comp ~ NARROW[fn.data];
        IF comp.left.MutabilityOf#constant THEN comp.left.Thaw[];
        IF comp.right.MutabilityOf#constant THEN comp.right.Thaw[];
        RETURN};

    CompRightCollection: PROC [fn: IntFn] RETURNS [UWColl] ~ {
        comp: Comp ~ NARROW[fn.data];
        RETURN comp.right.CollectionOn[right]};

    CompCurRange: PROC [fn: IntFn] RETURNS [ConstSet] ~ {
        comp: Comp ~ NARROW[fn.data];
        RETURN comp.right.CurSetOn[right]};

    CompRightSpace: PROC [fn: IntFn] RETURNS [Space] ~ {
        comp: Comp ~ NARROW[fn.data];
        RETURN [comp.right.Spaces[][right]]};

    Start: PROC ~ {
        FOR oneToOne: BOOL IN BOOL DO FOR isDense: BOOL IN BOOL DO FOR ordered: BOOL IN BOOL DO FOR domainFixed: BOOL IN BOOL DO FOR 
        leftRestricts: BOOL IN BOOL DO FOR rightRestricts: BOOL IN BOOL DO FOR canSize: BOOL IN BOOL DO FOR mutability: 
        UnwriteableMutability IN UnwriteableMutability DO
            compClasses[oneToOne][isDense][ordered][mutability][domainFixed][leftRestricts][rightRestricts][canSize] _ CreateClass[[
                Primitive: CompPrimitive,
                Widen: CompWiden,
                HasPair: CompHasPair,
                Apply: CompApply,
                InvApply: CompInvApply,
                Scan: CompScan,
                Extremum: IF NOT rightRestricts THEN CompExtremum ELSE NIL,
                Get3: IF NOT rightRestricts THEN CompGet3 ELSE NIL,
                Size: IF canSize THEN CompSize ELSE NIL,
                GetBounds: IF NOT rightRestricts THEN CompGetBounds ELSE NIL,
                ValueOf: CompValueOf,
                RightCollection: IF NOT leftRestricts THEN CompRightCollection ELSE NIL,
                CurRange: IF NOT leftRestricts THEN CompCurRange ELSE NIL,
                RightSpace: CompRightSpace,
                isOneToOne: oneToOne,
                isDense: isDense,
                ordered: ordered,
                mutability: mutability,
                domainFixed: domainFixed]];
            ENDLOOP ENDLOOP ENDLOOP ENDLOOP ENDLOOP ENDLOOP ENDLOOP ENDLOOP;
        };

    Start[];

    END.