
    <<BiRelsImpl.Mesa>>
        <<Last tweaked by Mike Spreitzer on March 4, 1988 5:10:39 pm PST>>

    DIRECTORY AbSets, Atom, BiRelBasics, BiRels, BiRelsPrivate, IntStuff, List, Process, Rope, SetBasics, SharedErrors;

    BiRelsImpl: CEDAR MONITOR
        LOCKS lp USING lp: LockPtr
        IMPORTS AbSets, Atom, BiRelBasics, BiRels, BiRelsPrivate, IntStuff, List, Process, SetBasics, SharedErrors
        EXPORTS BiRels
        =

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

    LockPtr: TYPE ~ LONG POINTER TO MONITORLOCK;

    Cant: PUBLIC ERROR [br: BiRel] ~ CODE;

    mappingNotSingleton: PUBLIC ROPE ~ R["mapping of %g isn't a singleton"];
    fixedSide: PUBLIC ROPE ~ R["%g's %g side can't be varied"];
    denseSide: PUBLIC ROPE ~ R["%g's %g side must remain dense"];
    notFunctional: PUBLIC ROPE ~ R["%g's must be functional %g"];

    badBiRel: PUBLIC BiRel ~ [NIL, R["bad BiRel"]];

    provisionKey: ATOM ~ $BiRelsImplProvision;
    dirableKey: ATOM ~ $BiRelsImplDirable;
    resableKey: ATOM ~ $BiRelsImplRestrictable;
    kindKey: ATOM ~ $BiRelsImplKind;
    refTwo: REF EINT ~ FromEI[two];

    Proc: TYPE ~ PROC ANY RETURNS ANY;

    ConsBiRel: PUBLIC PROC [class: BiRelClass, data: REF ANY] RETURNS [BiRel]
        ~ {RETURN [[class, data]]};

    CreateClass: PUBLIC PROC [cp: BiRelClassPrivate, dirable: BoolPair _ [TRUE, FALSE], restrictable: RestrictabilityPair _ ALL[none]] 
    RETURNS [class: BiRelClass] ~ {
        provs: Atom.PropList _ NARROW[List.Assoc[key: provisionKey, aList: cp.other]];
        Sp: PROC [op: ATOM, proc: Proc] RETURNS [def: BOOL] ~ {
            provs _ List.PutAssoc[op, IF (def _ proc=NIL) THEN $Default ELSE $Primitive, provs];
            RETURN};
        {OPEN cp;
        IF Sp[$AsSet, AsSet] THEN AsSet _ DefaultAsSet;
        IF Sp[$HasPair, HasPair] THEN HasPair _ DefaultHasPair;
        IF Sp[$Image, Image] THEN Image _ DefaultImage;
        IF Sp[$Apply, Apply] THEN Apply _ DefaultApply;
        IF Sp[$ScanRestriction, ScanRestriction] THEN ScanRestriction _ DefaultScanRestriction;
        IF Sp[$GetOne, GetOne] THEN GetOne _ DefaultGetOne;
        IF Sp[$Get3, Get3] THEN Get3 _ DefaultGet3;
        IF Sp[$Index, Index] THEN Index _ DefaultIndex;
        IF Sp[$RestrictionSize, RestrictionSize] THEN RestrictionSize _ DefaultRestrictionSize;
        IF Sp[$GetBounds, GetBounds] THEN GetBounds _ DefaultGetBounds;
        IF Sp[$Copy, Copy] THEN Copy _ DefaultCopy;
        IF Sp[$Insulate, Insulate] THEN Insulate _ DefaultInsulate;
        IF Sp[$ValueOf, ValueOf] THEN ValueOf _ DefaultValueOf;
        IF Sp[$Freeze, Freeze] THEN Freeze _ DefaultFreeze;
        IF Sp[$Thaw, Thaw] THEN Thaw _ DefaultThaw;
        IF Sp[$SetOn, SetOn] THEN SetOn _ DefaultSetOn;
        IF Sp[$CurSetOn, CurSetOn] THEN CurSetOn _ DefaultCurSetOn;
        IF Sp[$AddPair, AddPair] THEN AddPair _ DefaultAddPair;
        IF Sp[$AddSet, AddSet] THEN AddSet _ DefaultAddSet;
        IF Sp[$Swap, Swap] THEN Swap _ DefaultSwap;
        IF Sp[$RemPair, RemPair] THEN RemPair _ DefaultRemPair;
        IF Sp[$RemSet, RemSet] THEN RemSet _ DefaultRemSet;
        IF Sp[$Update, Update] THEN Update _ DefaultUpdate;
        IF Sp[$Delete, Delete] THEN Delete _ DefaultDelete;
        IF Sp[$DeleteSet, DeleteSet] THEN DeleteSet _ DefaultDeleteSet;
        IF Sp[$ReplaceMe, ReplaceMe] THEN ReplaceMe _ DefaultReplaceMe;
        IF Sp[$ShiftAndClipMe, ShiftAndClipMe] THEN ShiftAndClipMe _ DefaultShiftAndClipMe;
        IF Sp[$IsDense, IsDense] THEN IsDense _ DefaultIsDense;
        IF Sp[$SideFixed, SideFixed] THEN SideFixed _ DefaultSideFixed;
        };
        cp.other _ List.PutAssoc[provisionKey, provs, cp.other];
        cp.other _ List.PutAssoc[dirableKey, NEW [BoolPair _ dirable], cp.other];
        cp.other _ List.PutAssoc[resableKey, NEW [RestrictabilityPair _ restrictable], cp.other];
        class _ NEW [BiRelClassPrivate _ cp];
        RETURN};

    Primitive: PUBLIC PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANY _ NIL] RETURNS [BOOL] ~ {
        kind: REF ANY ~ Atom.GetProp[op, kindKey];
        IF arg1#NIL AND ISTYPE[arg1, LORA] THEN ERROR--somebody called with one LIST of args rather than separate args--;
        WITH kind SELECT FROM
            a: ATOM => SELECT a FROM
                $always => RETURN [TRUE];
                $argless => NULL;
                $composite => ERROR;
                ENDCASE => ERROR;
            a: REF ArgTyping => NULL;
            ENDCASE => ERROR;
        IF br.class.Primitive#NIL THEN SELECT br.class.Primitive[br, op, arg1, arg2] FROM
            yes => RETURN [TRUE];
            no => RETURN [FALSE];
            pass => NULL;
            ENDCASE => ERROR;
        {provs: Atom.PropList ~ NARROW[List.Assoc[provisionKey, br.class.other]];
        prov: REF ANY ~ List.Assoc[op, provs];
        SELECT prov FROM
            $Default => RETURN [FALSE];
            $Primitive => WITH kind SELECT FROM
                a: ATOM => SELECT a FROM
                    $argless => RETURN [TRUE];
                    $always, $composite => ERROR;
                    ENDCASE => ERROR;
                types: REF ArgTyping => {
                    args: ARRAY [1 .. 2] OF REF ANY ~ [arg1, arg2];
                    FOR i: NATURAL IN [1 .. 2] DO
                        type: ArgType ~ types[i];
                        SELECT type FROM
                            $None, $Set, $RelOrder, $RelOrderFN, $Want3, $limit, $When, $Side, $EndBools, $BiRel => NULL;
                            $Dir => {dir: Direction ~ ToDir[args[i]];
                                dirable: REF BoolPair ~ NARROW[List.Assoc[dirableKey, br.class.other]];
                                IF NOT dirable[dir] THEN RETURN [FALSE]};
                            $SetPair => {rsp: RefSetPair ~ ToSets[args[i]];
                                resable: REF RestrictabilityPair ~ NARROW[List.Assoc[resableKey, br.class.other]];
                                FOR side: Side IN Side DO
                                    SELECT resable[From[side]] FROM
                                        none => IF rsp[side]#nilSet THEN RETURN [FALSE];
                                        tiny => IF rsp[side]#nilSet AND NOT (rsp[side].GoodImpl[$Size, refTwo] AND rsp[side].Size[two].Compare[two]<equal) THEN RETURN 
                                        [FALSE];
                                        any => NULL;
                                        ENDCASE => ERROR;
                                    ENDLOOP;
                                };
                            $remove => IF br.MutabilityOf[]#variable AND ToBool[args[i]] THEN RETURN [TRUE];
                            ENDCASE => ERROR;
                        ENDLOOP;
                    RETURN [TRUE]};
                ENDCASE => ERROR;
            ENDCASE => ERROR;
        }};

    refOne: RefEINT ~ FromEI[one];
    refSetAllInts: RefSet ~ Sets.IIAsSet[[]].Refify;

    QualityOf: PUBLIC PROC [br: BiRel, op: ATOM, arg1, arg2, arg3, arg4: REF ANY _ NIL] RETURNS [ImplQuality] ~ {
        IF arg1#NIL AND ISTYPE[arg1, LORA] THEN ERROR--somebody called with one LIST of args rather than separate args--;
        WITH Atom.GetProp[op, kindKey] SELECT FROM
            a: ATOM => SELECT a FROM
                $always => RETURN [primitive];
                $argless => NULL;
                $composite => SELECT op FROM
                    $Mapping => {dir: Direction ~ ToDir[arg1];
                        RETURN br.QualityOf[$Image, Sets.FakeRefSingleton[br.Spaces[][Source[dir]]], FromDir[dir]]};
                    $HasMapping => {from: Side ~ Source[ToDir[arg1]];
                        RETURN br.QualityOf[$ScanRestriction, FromSets[ConsSets[from, Sets.FakeSingleton[br.Spaces[][from]]]]]};
                    $Enumerate => RETURN br.QualityOf[$Scan, arg1, arg2, arg3, arg4];
                    $Scan => RETURN br.QualityOf[$ScanRestriction, refNilSets, arg1];
                    $EnumerateImage => RETURN br.QualityOf[$ScanImage, arg1, arg2, arg3, arg4];
                    $ScanImage => {
                        set: RefSet ~ ToSet[arg1];
                        dir: Direction ~ ToDir[arg2];
                        ro: Sets.RelOrder ~ Sets.ToRO[arg3];
                        RETURN br.QualityOf[$ScanHalfRestriction, set, FromSide[Source[dir]], FromRO[ConsRelOrder[Dest[dir], ro]]]};
                    $EnumerateMapping => {
                        dir: Direction ~ ToDir[arg1];
                        RETURN br.QualityOf[$EnumerateImage, Sets.FakeRefSingleton[br.Spaces[][Source[dir]]], FromDir[dir], arg2]};
                    $ScanMapping => {
                        dir: Direction ~ ToDir[arg1];
                        RETURN br.QualityOf[$ScanImage, Sets.FakeRefSingleton[br.Spaces[][Source[dir]]], FromDir[dir], arg2]};
                    $EnumerateHalfRestriction => RETURN br.QualityOf[$ScanHalfRestriction, arg1, arg2, arg3, arg4];
                    $ScanHalfRestriction => RETURN br.QualityOf[$ScanRestriction, FromSets[ConsSets[ToSide[arg2], ToSet[arg1]^]], arg3];
                    $APair => RETURN QMin[br.QualityOf[$GetOne, $FALSE, arg1, arg2], goodDefault];
                    $Pop => RETURN QMin[br.QualityOf[$GetOne, $TRUE, arg1, arg2], goodDefault];
                    $Next => RETURN br.QualityOf[$Get3, FromRO[ToRO[arg1, [[fwd, no]]]], $FFT];
                    $Prev => RETURN br.QualityOf[$Get3, FromRO[ToRO[arg1, [[fwd, no]]]], $TFF];
                    $SkipTo => {
                        goal: RefSet ~ ToSet[arg1];
                        bounds: Interval ~ ToInterval[arg2]^;
                        side: Side ~ ToSide[arg3];
                        os: Side ~ OtherSide[side];
                        bwd: BOOL ~ ToBool[arg4];
                        RETURN br.QualityOf[$ScanRestriction, FromSets[ConsSets[side, goal^, IntervalAsSet[br.Spaces[][os], bounds]]], 
                        FromRO[ConsRelOrder[os, IF bwd THEN bwd ELSE fwd]]]};
                    $Lookup => {
                        bounds: RefInterval ~ ToInterval[arg1];
                        side: Side ~ ToSide[arg2];
                        RETURN br.QualityOf[$SkipTo, Sets.FakeRefSingleton[br.Spaces[][side]], arg1, arg2, arg3]};
                    $Size => RETURN br.QualityOf[$RestrictionSize, refNilSets, arg1];
                    $Empty => RETURN br.QualityOf[$Size, refOne];
                    $ImageSize => {set: Set ~ ToSet[arg1]^;
                        limit: RefEINT ~ ToEI[arg3];
                        easy: BOOL ~ set.GoodImpl[$Size, refTwo] AND set.Size[two].Compare[two]<equal;
                        IF easy THEN RETURN br.QualityOf[$RestrictionSize, FromSets[ConsSets[Source[ToDir[arg2]], set]], limit];
                        IF NOT br.Can[$Scan] THEN RETURN [cant];
                        RETURN [IF limit^.Compare[two]<=equal THEN goodDefault ELSE poorDefault]};
                    $MappingSize => {
                        dir: Direction ~ ToDir[arg1];
                        RETURN br.QualityOf[$ImageSize, Sets.FakeRefSingleton[br.Spaces[][Source[dir]]], FromDir[dir], arg2]};
                    $AddNewPair => RETURN br.QualityOf[$AddPair];
                    $AddNewSet => RETURN br.QualityOf[$AddSet, arg1];
                    $Erase => RETURN br.QualityOf[$RemSet, br.Refify];
                    $Substitute => {side: Side ~ ToSide[arg1];
                        RETURN QMin[
                            br.QualityOf[$Mapping, FromDir[From[side]]],
                            br.QualityOf[$AddSet]]
                            .QMin[IF br.Functional[][To[side]] THEN primitive ELSE br.QualityOf[$Delete, FromSide[side]]]};
                    $GetIntDom => RETURN br.QualityOf[$GetBounds, arg1, arg2, arg3, arg4];
                    ENDCASE => ERROR;
                ENDCASE => ERROR;
            a: REF ArgTyping => NULL;
            ENDCASE => ERROR;
        IF Primitive[br, op, arg1, arg2] THEN RETURN [primitive];
        SELECT op FROM
            $AsSet => RETURN [goodDefault];
            $HasPair => {spaces: SpacePair ~ br.Spaces[];
                RETURN br.QualityOf[$ScanRestriction, FromSets[[Sets.FakeSingleton[spaces[left]], 
                Sets.FakeSingleton[spaces[right]]]]].QMin[goodDefault]};
            $Image => {set: RefSet ~ ToSet[arg1];
                dir: Direction ~ ToDir[arg2];
                RETURN [IF br.GoodImpl[$ScanRestriction, FromSets[ConsSets[Source[dir], set^]]] THEN goodDefault ELSE poorDefault]};
            $Apply => {dir: Direction ~ ToDir[arg1];
                IF br.Functional[][dir] AND Primitive[br, $Update, arg1] THEN RETURN [goodDefault];
                {src: Side ~ Source[dir];
                RETURN br.QualityOf[$ScanRestriction, FromSets[ConsSets[src, Sets.CreateSingleton[noValue, br.Spaces[][src]]]]].QMin[goodDefault]}};
            $ScanRestriction => {
                sets: RefSetPair ~ ToSets[arg1];
                ro: RelOrder ~ ToRO[arg2].CanonizeRelOrder[br.Functional[]];
                plan: BiRelsPrivate.Analysis;
                can: BOOL;
                [can, plan] _ BiRelsPrivate.PlanDefaultScanRestriction[br, sets^, ro];
                IF NOT can THEN RETURN [cant];
                RETURN [IF plan.cost.sort = ALL[asIs] THEN goodDefault ELSE poorDefault]};
            $GetOne => {remove: BOOL ~ ToBool[arg1];
                ro: RelOrder ~ ToRO[arg2];
                IF remove AND br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                IF Primitive[br, $ScanRestriction, refNilSets, arg2] THEN RETURN [goodDefault];
                RETURN br.QualityOf[$Scan].QMin[
                    IF remove THEN br.QualityOf[$RemPair].QMin[poorDefault] ELSE poorDefault]};
            $Get3 => {
                ro: RelOrder ~ ToRO[arg1, [[fwd, no]]].CanonizeRelOrder[br.Functional];
                fq, bq, nq: ImplQuality _ br.QualityOf[$Scan, FromRO[ro]];
                rro: RelOrder;
                IF ro.sub # ALL[no] THEN {
                    rro _ ro.ReverseRO[];
                    bq _ br.QualityOf[$Scan, FromRO[rro]];
                    nq _ br.QualityOf[$Scan]};
                {max: ImplQuality ~ QMax[nq, QMax[fq, bq]];
                uro: RelOrder ~ IF bq=max AND fq<max THEN rro ELSE IF fq=max THEN ro ELSE [];
                RETURN br.QualityOf[$Scan, FromRO[uro]].QMin[goodDefault]}};
            $Index => {goal: IntRel ~ ToBiRel[arg1]^;
                RETURN QMin[QMin[poorDefault, goal.QualityOf[$GetIntDom]],
                    QMin[br.QualityOf[$Mapping], goal.QualityOf[$Mapping]]]};
            $RestrictionSize => {
                sets: RefSetPair ~ ToSets[arg1];
                limit: EINT ~ ToEI[arg2]^;
                RETURN br.QualityOf[$ScanRestriction, sets].QMin[IF limit.Compare[two]<=equal THEN goodDefault ELSE poorDefault]};
            $GetBounds => {
                want: EndBools ~ ToEB[arg1];
                ro: RelOrder ~ ToRO[arg2, [[fwd, no]]].CanonizeRelOrder[br.Functional];
                rro: RelOrder ~ ro.ReverseRO[];
                IF
                    ((NOT want[min]) OR Primitive[br, $ScanRestriction, refNilSets, FromRO[ro]]) AND
                    ((NOT want[max]) OR Primitive[br, $ScanRestriction, refNilSets, FromRO[rro]])
                THEN {q: ImplQuality _ goodDefault;
                    FOR e: End IN End DO
                        IF want[e] THEN {
                            uro: RelOrder ~ IF e=min THEN ro ELSE rro;
                            q _ q.QMin[br.QualityOf[$APair, FromRO[uro]]]};
                        ENDLOOP;
                    RETURN [q]}
                ELSE RETURN br.QualityOf[$Scan].QMin[poorDefault]};
            $Copy => RETURN [cant];
            $Insulate => RETURN [goodDefault];
            $ValueOf => RETURN [IF br.MutabilityOf#constant THEN QMin[br.QualityOf[$Copy], br.QualityOf[$Freeze]].QMin[goodDefault] ELSE 
            goodDefault];
            $Freeze, $Thaw => RETURN [IF br.MutabilityOf#variable THEN goodDefault ELSE cant];
            $SetOn => RETURN [poorDefault];
            $CurSetOn => RETURN [IF br.MutabilityOf=constant THEN poorDefault ELSE cant];
            $AddPair => {
                IF br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                IF br.Functional[]#ALL[FALSE] THEN FOR dir: Direction IN Direction DO
                    IF br.Functional[][dir] AND NOT Primitive[br, $Update, FromDir[dir]] THEN EXIT;
                    REPEAT FINISHED => RETURN [goodDefault];
                    ENDLOOP;
                RETURN [IF Primitive[br, $AddSet, FakeRefSingleton[br.Spaces[]]] THEN goodDefault ELSE cant];
                };
            $AddSet => {
                IF br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                IF br.Functional[]#ALL[FALSE] THEN FOR dir: Direction IN Direction DO
                    IF br.Functional[][dir] AND NOT Primitive[br, $Update, FromDir[dir]] THEN EXIT;
                    REPEAT FINISHED => RETURN [goodDefault];
                    ENDLOOP;
                RETURN [IF Primitive[br, $AddPair] THEN goodDefault ELSE cant];
                };
            $Swap => {side: Side ~ ToSide[arg1]; dir: Direction ~ From[side];
                IF br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                RETURN QMin[goodDefault, QMin[QMin[
                    br.QualityOf[$Mapping, FromDir[dir]],
                    br.QualityOf[$Delete, FromSide[side]]], QMin[
                    br.QualityOf[$ScanMapping, FromDir[dir]],
                    br.QualityOf[$AddPair]]]]};
            $RemPair => {spaces: SpacePair ~ br.Spaces[];
                IF br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                IF br.Functional[]#ALL[FALSE] THEN FOR dir: Direction IN Direction DO
                    IF br.Functional[][dir] AND NOT Primitive[br, $Update, FromDir[dir]] THEN EXIT;
                    REPEAT FINISHED => RETURN [goodDefault];
                    ENDLOOP;
                IF Primitive[br, $RemSet, FakeRefSingleton[spaces]] THEN RETURN [goodDefault];
                IF br.Functional[]#ALL[FALSE] THEN {
                    goodDelete: BoolPair _ ALL[FALSE];
                    FOR dir: Direction IN Direction DO
                        src: Side ~ Source[dir];
                        IF br.Functional[][dir] THEN {
                            IF br.GoodImpl[$Apply, FromDir[dir]] THEN goodDelete[dir] _ br.Primitive[$Delete, FromSide[src]] OR br.Primitive[$DeleteSet, 
                            Sets.FakeRefSingleton[spaces[src]], FromSide[src]]
                            ELSE EXIT};
                        REPEAT FINISHED => IF goodDelete#ALL[FALSE] THEN RETURN [goodDefault];
                        ENDLOOP;
                    op _ op};
                RETURN [cant]};
            $RemSet => {
                IF br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                IF br.Primitive[$RemPair] THEN RETURN [goodDefault];
                IF br.Functional[]#ALL[FALSE] THEN {
                    FOR dir: Direction IN Direction DO
                        IF br.Functional[][dir] AND NOT Primitive[br, $Update, FromDir[dir]] THEN EXIT;
                        REPEAT FINISHED => RETURN [goodDefault];
                        ENDLOOP;
                    {spaces: SpacePair ~ br.Spaces[];
                    goodDelete: BoolPair _ ALL[FALSE];
                    FOR dir: Direction IN Direction DO
                        src: Side ~ Source[dir];
                        IF br.Functional[][dir] THEN {
                            IF br.GoodImpl[$Apply, FromDir[dir]] THEN goodDelete[dir] _ br.Primitive[$Delete, FromSide[src]] OR br.Primitive[$DeleteSet, 
                            Sets.FakeRefSingleton[spaces[src]], FromSide[src]]
                            ELSE EXIT};
                        REPEAT FINISHED => IF goodDelete#ALL[FALSE] THEN RETURN [goodDefault];
                        ENDLOOP;
                    op _ op}};
                RETURN [cant]};
            $Update => RETURN QMin[
                QMin[goodDefault, br.QualityOf[$Apply, arg1]],
                QMin[br.QualityOf[$AddPair], br.QualityOf[$RemPair]]];
            $Delete => {side: Side ~ ToSide[arg1];
                dir: Direction ~ From[side];
                IF br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                IF br.Functional[][dir] AND Primitive[br, $Update, FromDir[dir]] THEN RETURN [goodDefault];
                RETURN QMin[goodDefault, br.QualityOf[$DeleteSet, Sets.FakeRefSingleton[br.Spaces[][side]], FromSide[side]]]};
            $DeleteSet => {set: RefSet ~ ToSet[arg1];
                side: Side ~ ToSide[arg2];
                dir: Direction ~ From[side];
                IF br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                IF Primitive[br, $Delete, FromSide[side]] OR br.Functional[][dir] AND Primitive[br, $Update, FromDir[dir]] THEN RETURN 
                [goodDefault];
                RETURN QMin[QMin[
                    set^.QualityOf[$Scan],
                    br.QualityOf[$RemPair]], QMin[
                    br.QualityOf[$ScanMapping, FromDir[dir]],
                    poorDefault]]};
            $ReplaceMe => {with: IntRel ~ ToBiRel[arg1]^;
                IF br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                RETURN QMin[QMin[
                    with.QualityOf[$GetIntDom],
                    br.QualityOf[$DeleteSet, refSetAllInts]], QMin[
                    SubShiftQuality[br],
                    br.QualityOf[$AddSet, with.Refify]]].QMin[
                    poorDefault]};
            $ShiftAndClipMe => {
                IF br.MutabilityOf[]#variable THEN RETURN [goodDefault];
                RETURN QMin[br.QualityOf[$DeleteSet, refSetAllInts], SubShiftQuality[br]].QMin[poorDefault]};
            $IsDense => RETURN [poorDefault];
            $SideFixed => RETURN [IF br.MutabilityOf[]=constant THEN goodDefault ELSE poorDefault];
            ENDCASE => ERROR;
        };

    SubShiftQuality: PROC [br: BiRel] RETURNS [ImplQuality] ~ {
        RETURN QMin[QMin[
            br.QualityOf[$GetIntDom],
            br.QualityOf[$ScanMapping]], QMin[
            br.QualityOf[$AddPair],
            br.QualityOf[$RemPair]]]};

    Enumerate: PUBLIC PROC [br: BiRel, Consume: PROC [Pair], ro: RelOrder _ []] ~ {
        EnumTest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair]; RETURN [FALSE]};
        IF br.Scan[EnumTest, ro].found THEN ERROR};

    EnumAA: PUBLIC PROC [br: BiRel, Consume: PROC [REF ANY, REF ANY], ro: RelOrder _ []] ~ {
        EnumAATest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[left].VA, pair[right].VA]; RETURN [FALSE]};
        IF br.Scan[EnumAATest, ro].found THEN ERROR};

    EnumIA: PUBLIC PROC [br: BiRel, Consume: PROC [INT, REF ANY], ro: RelOrder _ []] ~ {
        EnumIATest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[left].VI, pair[right].VA]; RETURN [FALSE]};
        IF br.Scan[EnumIATest, ro].found THEN ERROR};

    EnumII: PUBLIC PROC [br: BiRel, Consume: PROC [INT, INT], ro: RelOrder _ []] ~ {
        EnumIITest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[left].VI, pair[right].VI]; RETURN [FALSE]};
        IF br.Scan[EnumIITest, ro].found THEN ERROR};

    EnumerateImage: PUBLIC PROC [br: BiRel, set: Set, Consume: PROC [Value], dir: Direction _ leftToRight, ro: Sets.RelOrder _ no] ~ {
        dest: Side ~ Dest[dir];
        EnumImageTest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[dest]]; RETURN [FALSE]};
        IF br.ScanHalfRestriction[set, EnumImageTest, Source[dir], ConsRelOrder[dest, ro]].found THEN ERROR;
        RETURN};

    Forked: TYPE ~ REF ForkedPrivate;
    ForkedPrivate: TYPE ~ RECORD [
        set: ARRAY Which OF BiRel,
        ready: ARRAY Which OF BOOL _ ALL[FALSE],
        done: BOOL _ FALSE,
        change: CONDITION _ [timeout: Process.SecondsToTicks[10]],
        val: ARRAY Which OF MaybePair _ ALL[[TRUE, noPair]],
        lock: MONITORLOCK _ []
        ];

    InterleavedProduceRestriction: PUBLIC PROC [a, b: BiRel, Consume: InterleavedConsumer, setsA, setsB: SetPair _ [], roA, roB: 
    RelOrder _ []] RETURNS [ans: MaybePair _ noMaybePair] ~ {
        fkd: Forked ~ NEW [ForkedPrivate _ [set: [a, b]]];
        GenA: PROC ~ {ForkScan[fkd, a, setsA, roA]};
        GenB: PROC ~ {ForkScan[fkd, b, setsB, roB]};
        TestAB: PROC ~ {
            Produce: PROC [w: Which] RETURNS [MaybePair] ~ {
                Wait: ENTRY PROC [lp: LockPtr] RETURNS [MaybePair] ~ {
                    ENABLE UNWIND => NULL;
                    UNTIL fkd.ready[w] DO WAIT fkd.change ENDLOOP;
                    RETURN [fkd.val[w]]};
                TRUSTED {RETURN Wait[@fkd.lock]}};
            Finish: ENTRY PROC [lp: LockPtr] ~ {
                ENABLE UNWIND => NULL;
                fkd.done _ TRUE;
                fkd.ready _ ALL[FALSE];
                BROADCAST fkd.change;
                RETURN};
            ans _ Consume[Produce];
            TRUSTED {Finish[@fkd.lock]};
            RETURN};
        TRUSTED {
            Process.EnableAborts[@fkd.change];
            SharedErrors.Fork[LIST[GenA, GenB, TestAB]]};
        RETURN};

    ParallelScanRestriction: PUBLIC PROC [a, b: BiRel, Test: ParallelTester, setsA, setsB: SetPair _ [], roA, roB: RelOrder _ []] 
    RETURNS [pf: ParallelFind _ [FALSE, noMaybePair, noMaybePair]] ~ {
        fkd: Forked ~ NEW [ForkedPrivate _ [set: [a, b] ]];
        GenA: PROC ~ {ForkScan[fkd, a, setsA, roA]};
        GenB: PROC ~ {ForkScan[fkd, b, setsB, roB]};
        TestAB: PROC ~ {
            WaitForReq: ENTRY PROC [lp: LockPtr] RETURNS [continue: BOOL] ~ {
                ENABLE UNWIND => NULL;
                DO
                    IF NOT fkd.ready[a] THEN {WAIT fkd.change; LOOP};
                    IF NOT fkd.ready[b] THEN {WAIT fkd.change; LOOP};
                    RETURN [fkd.val[a].found OR fkd.val[b].found];
                    ENDLOOP;
                };
            Satisfy: ENTRY PROC [lp: LockPtr] ~ {
                ENABLE UNWIND => NULL;
                fkd.ready[a] _ fkd.ready[b] _ FALSE;
                BROADCAST fkd.change;
                RETURN};
            TRUSTED {UNTIL fkd.done DO
                IF NOT WaitForReq[@fkd.lock]
                    THEN fkd.done _ TRUE
                    ELSE {IF (fkd.done _ Test[fkd.val[a], fkd.val[b]]) THEN pf _ [TRUE, fkd.val[a], fkd.val[b]]};
                Satisfy[@fkd.lock];
                ENDLOOP};
            RETURN};
        TRUSTED {
            Process.EnableAborts[@fkd.change];
            SharedErrors.Fork[LIST[GenA, GenB, TestAB]]};
        RETURN};

    ForkScan: PROC [fkd: Forked, which: Which, sets: SetPair, ro: RelOrder] ~ {
        Mediate: PROC [val: Pair] RETURNS [pass: BOOL _ FALSE] ~ {
            WithLock: ENTRY PROC [lp: LockPtr] ~ {
                ENABLE UNWIND => NULL;
                fkd.val[which].it _ val;
                fkd.ready[which] _ TRUE;
                BROADCAST fkd.change;
                UNTIL NOT fkd.ready[which] DO WAIT fkd.change ENDLOOP;
                pass _ fkd.done;
                RETURN};
        TRUSTED {WithLock[@fkd.lock]};
        RETURN};
        Finish: ENTRY PROC [lp: LockPtr] ~ {
            ENABLE UNWIND => NULL;
            fkd.val[which] _ noMaybePair;
            UNTIL fkd.done DO
                fkd.ready[which] _ TRUE;
                BROADCAST fkd.change;
                UNTIL NOT fkd.ready[which] DO WAIT fkd.change ENDLOOP;
                ENDLOOP;
            RETURN};
        [] _ fkd.set[which].ScanRestriction[sets, Mediate, ro];
        TRUSTED {Finish[@fkd.lock]};
        RETURN};

    EnumerateHalfRestriction: PUBLIC PROC [br: BiRel, set: Set, Consume: PROC [Pair], side: Side _ left, ro: RelOrder _ []] ~ {
        EnumHRTest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair]; RETURN [FALSE]};
        IF br.ScanHalfRestriction[set, EnumHRTest, side, ro].found THEN ERROR;
        RETURN};

    ScanImage: PUBLIC PROC [br: BiRel, set: Set, Test: Sets.Tester, dir: Direction _ leftToRight, ro: Sets.RelOrder _ no] RETURNS 
    [MaybePair] ~ {
        dest: Side ~ Dest[dir];
        ScanImageTest: PROC [pair: Pair] RETURNS [BOOL] ~ {RETURN Test[pair[dest]]};
        RETURN br.ScanHalfRestriction[set, ScanImageTest, Source[dir], ConsRelOrder[dest, ro]]};

    Has: PUBLIC PROC [br, other: BiRel, want: BoolPair] RETURNS [hsp: HadSetPair _ []] ~ {
        spaces: SpacePair ~ br.Spaces[];
        Per: PROC [pair: Pair] RETURNS [BOOL] ~ {
            IF want[leftToRight] THEN {
                mv: MaybeValue ~ br.Apply[pair[left], leftToRight];
                SELECT TRUE FROM
                    NOT mv.found => hsp[leftToRight][none] _ TRUE;
                    spaces[right].SEqual[pair[right], mv.it] => hsp[leftToRight][same] _ TRUE;
                    ENDCASE => hsp[leftToRight][different] _ TRUE};
            IF want[rightToLeft] THEN {
                mv: MaybeValue ~ br.Apply[pair[right], rightToLeft];
                SELECT TRUE FROM
                    NOT mv.found => hsp[rightToLeft][none] _ TRUE;
                    spaces[left].SEqual[pair[left], mv.it] => hsp[rightToLeft][same] _ TRUE;
                    ENDCASE => hsp[rightToLeft][different] _ TRUE};
            RETURN [FALSE]};
        IF want#ALL[FALSE] AND other.Scan[Per].found THEN ERROR;
        RETURN};

    AddAA: PUBLIC PROC [br: BiRel, left, right: REF ANY, if: IfHadPair _ alwaysAdd] RETURNS [had: HadPair]
        ~ {RETURN br.AddPair[[AV[left], AV[right]], if]};

    AddIA: PUBLIC PROC [br: BiRel, left: INT, right: REF ANY, if: IfHadPair _ alwaysAdd] RETURNS [had: HadPair]
        ~ {RETURN br.AddPair[[IV[left], AV[right]], if]};

    AddII: PUBLIC PROC [br: BiRel, left, right: INT, if: IfHadPair _ alwaysAdd] RETURNS [had: HadPair]
        ~ {RETURN br.AddPair[[IV[left], IV[right]], if]};

    AddNewPair: PUBLIC PROC [br: BiRel, pair: Pair] ~ {
        had: HadPair ~ br.AddPair[pair, addIfNew];
        IF br.Functional[][leftToRight] AND had[leftToRight]#none THEN ERROR;
        IF br.Functional[][rightToLeft] AND had[rightToLeft]#none THEN ERROR;
        RETURN};

    AddNewAA: PUBLIC PROC [br: BiRel, left, right: REF ANY] ~ {
        had: HadPair ~ br.AddPair[[AV[left], AV[right]], addIfNew];
        IF br.Functional[][leftToRight] AND had[leftToRight]#none THEN ERROR;
        IF br.Functional[][rightToLeft] AND had[rightToLeft]#none THEN ERROR;
        RETURN};

    AddNewIA: PUBLIC PROC [br: BiRel, left: INT, right: REF ANY] ~ {
        had: HadPair ~ br.AddPair[[IV[left], AV[right]], addIfNew];
        IF br.Functional[][leftToRight] AND had[leftToRight]#none THEN ERROR;
        IF br.Functional[][rightToLeft] AND had[rightToLeft]#none THEN ERROR;
        RETURN};

    AddNewII: PUBLIC PROC [br: BiRel, left, right: INT] ~ {
        had: HadPair ~ br.AddPair[[IV[left], IV[right]], addIfNew];
        IF br.Functional[][leftToRight] AND had[leftToRight]#none THEN ERROR;
        IF br.Functional[][rightToLeft] AND had[rightToLeft]#none THEN ERROR;
        RETURN};

    RemAA: PUBLIC PROC [br: BiRel, left, right: REF ANY] RETURNS [had: HadPair]
        ~ {RETURN br.RemPair[[AV[left], AV[right]]]};

    RemIA: PUBLIC PROC [br: BiRel, left: INT, right: REF ANY] RETURNS [had: HadPair]
        ~ {RETURN br.RemPair[[IV[left], AV[right]]]};

    RemII: PUBLIC PROC [br: BiRel, left, right: INT] RETURNS [had: HadPair]
        ~ {RETURN br.RemPair[[IV[left], IV[right]]]};

    RemOldPair: PUBLIC PROC [br: BiRel, pair: Pair] ~ {
        had: HadPair ~ br.RemPair[pair];
        IF br.Functional[][leftToRight] AND had[leftToRight]#same THEN ERROR;
        IF br.Functional[][rightToLeft] AND had[rightToLeft]#same THEN ERROR;
        };

    RemOldAA: PUBLIC PROC [br: BiRel, left, right: REF ANY] ~ {
        had: HadPair ~ br.RemPair[[AV[left], AV[right]]];
        IF br.Functional[][leftToRight] AND had[leftToRight]#same THEN ERROR;
        IF br.Functional[][rightToLeft] AND had[rightToLeft]#same THEN ERROR;
        };

    RemOldIA: PUBLIC PROC [br: BiRel, left: INT, right: REF ANY] ~ {
        had: HadPair ~ br.RemPair[[IV[left], AV[right]]];
        IF br.Functional[][leftToRight] AND had[leftToRight]#same THEN ERROR;
        IF br.Functional[][rightToLeft] AND had[rightToLeft]#same THEN ERROR;
        };

    RemOldII: PUBLIC PROC [br: BiRel, left, right: INT] ~ {
        had: HadPair ~ br.RemPair[[IV[left], IV[right]]];
        IF br.Functional[][leftToRight] AND had[leftToRight]#same THEN ERROR;
        IF br.Functional[][rightToLeft] AND had[rightToLeft]#same THEN ERROR;
        };

    Substitute: PUBLIC PROC [br: BiRel, old, new: Value, side: Side] ~ {
        image: Set ~ br.Mapping[old, From[side]];
        [] _ br.AddSet[CreateProduct[ConsSets[side, Sets.CreateSingleton[new, br.Spaces[][side]], image]]];
        IF NOT br.Functional[][To[side]] THEN [] _ br.Delete[old, side];
        RETURN};

    refNilSets: REF ANY ~ FromSets[ALL[nilSet]];

    AddComposite: PROC [op: ATOM] ~ {
        Atom.PutProp[prop: kindKey, val: $composite, atom: op];
        };
    AddAlways: PROC [op: ATOM] ~ {
        Atom.PutProp[prop: kindKey, val: $always, atom: op];
        };
    AddArgless: PROC [op: ATOM] ~ {
        Atom.PutProp[prop: kindKey, val: $argless, atom: op];
        };
    AddArgfull: PROC [op: ATOM, arg1, arg2: ArgType _ None] ~ {
        Atom.PutProp[prop: kindKey, val: NEW [ArgTyping _ [arg1, arg2]], atom: op];
        };

    Start: PROC ~ {
        AddComposite[$Mapping];
        AddComposite[$Enumerate];
        AddComposite[$Scan];
        AddComposite[$EnumerateImage];
        AddComposite[$ScanImage];
        AddComposite[$EnumerateMapping];
        AddComposite[$ScanMapping];
        AddComposite[$EnumerateHalfRestriction];
        AddComposite[$ScanHalfRestriction];
        AddComposite[$APair];
        AddComposite[$Pop];
        AddComposite[$Next];
        AddComposite[$Prev];
        AddComposite[$SkipTo];
        AddComposite[$Lookup];
        AddComposite[$Size];
        AddComposite[$Empty];
        AddComposite[$ImageSize];
        AddComposite[$MappingSize];
        AddComposite[$AddNewPair];
        AddComposite[$AddNewSet];
        AddComposite[$Erase];
        AddComposite[$Substitute];
        AddComposite[$GetIntDom];
        AddArgless[$AsSet];
        AddArgless[$HasPair];
        AddArgfull[$Image, $Set, $Dir];
        AddArgfull[$Apply, $Dir];
        AddArgfull[$ScanRestriction, $SetPair, $RelOrder];
        AddArgfull[$GetOne, $remove, $RelOrder];
        AddArgfull[$Get3, $RelOrderFN, $Want3];
        AddArgfull[$RestrictionSize, $SetPair, $limit];
        AddArgfull[$IsDense, $When, $Side];
        AddArgfull[$SideFixed, $Side];
        AddArgfull[$GetBounds, $EndBools, $RelOrderFN];
        AddArgless[$Copy];
        AddArgless[$Insulate];
        AddArgless[$ValueOf];
        AddArgless[$Freeze];
        AddArgless[$Thaw];
        AddArgless[$AddPair];
        AddArgfull[$AddSet, $BiRel];
        AddArgfull[$Swap, $Side];
        AddArgless[$RemPair];
        AddArgfull[$RemSet, $BiRel];
        AddArgfull[$Update, $Dir];
        AddArgless[$Delete];
        AddArgfull[$DeleteSet, $Set, $Side];
        AddArgless[$QuaIntInterval];
        AddAlways[$MutabilityOf];
        AddAlways[$Spaces];
        AddArgfull[$SetOn, $Side];
        AddArgfull[$CurSetOn, $Side];
        AddAlways[$Functional];
        AddAlways[$PreservePair];
        RETURN};
        <<FOR l2r: BOOL IN BOOL DO FOR r2l: BOOL IN BOOL DO FOR mut: Mutability IN Mutability DO>>
            <<classes[l2r][r2l][mut] _ CreateClass[>>
                <<cp: [>>
                    <<Primitive: PrefixPrimitive,>>
                    <<AsSet: PrefixAsSet,>>
                    <<HasPair: PrefixHasPair,>>
                    <<Image: PrefixImage,>>
                    <<Apply: PrefixApply,>>
                    <<ScanRestriction: PrefixScanRestriction,>>
                    <<GetOne: PrefixGetOne,>>
                    <<Get3: PrefixGet3,>>
                    <<Index: PrefixIndex,>>
                    <<RestrictionSize: PrefixRestrictionSize,>>
                    <<GetBounds: PrefixGetBounds,>>
                    <<Copy: PrefixCopy,>>
                    <<Insulate: IF mut=variable THEN PrefixInsulate ELSE NIL,>>
                    <<ValueOf: IF mut#constant THEN PrefixValueOf ELSE NIL,>>
                    <<Freeze: IF mut=variable THEN PrefixFreeze ELSE NIL,>>
                    <<Thaw: IF mut=variable THEN PrefixThaw ELSE NIL,>>
                    <<SetOn: PrefixSetOn,>>
                    <<CurSetOn: PrefixCurSetOn,>>
                    <<AddPair: IF mut=variable THEN PrefixAddPair ELSE NIL,>>
                    <<AddSet: IF mut=variable THEN PrefixAddSet ELSE NIL,>>
                    <<Swap: IF mut=variable THEN PrefixSwap ELSE NIL,>>
                    <<RemPair: IF mut=variable THEN PrefixRemPair ELSE NIL,>>
                    <<RemSet: IF mut=variable THEN PrefixRemSet ELSE NIL,>>
                    <<Update: PrefixUpdate,>>
                    <<Delete: IF mut=variable THEN PrefixDelete ELSE NIL,>>
                    <<DeleteSet: IF mut=variable THEN PrefixDeleteSet ELSE NIL,>>
                    <<ReplaceMe: IF mut=variable THEN PrefixReplaceMe ELSE NIL,>>
                    <<ShiftAndClipMe: IF mut=variable THEN PrefixShiftAndClipMe ELSE NIL,>>
                    <<Spaces: PrefixSpaces,>>
                    <<IsDense: PrefixIsDense,>>
                    <<SideFixed: PrefixSideFixed,>>
                    <<functional: [l2r, r2l],>>
                    <<mutability: mut],>>
                <<dirable: ALL[TRUE],>>
                <<restrictable: [tiny, none]>>
                <<];>>
            <<ENDLOOP ENDLOOP ENDLOOP;>>

    Start[];

    END.