
    <<BiRelDefaults3.Mesa>>
        <<Last tweaked by Mike Spreitzer on January 20, 1988 8:32:51 pm PST>>

    DIRECTORY AbSets, Atom, BiRelBasics, BiRels, IntStuff, SetBasics;

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

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

    DefaultInsulate: PUBLIC PROC [br: BiRel] RETURNS [UWBiRel] ~ {
        fnl: BoolPair ~ br.Functional[];
        RETURN AsUW[[insClasses[fnl[leftToRight]][fnl[rightToLeft]], br.Refify]]};

    InsClasses: TYPE ~ ARRAY --l2r--BOOL OF ARRAY --r2l--BOOL OF BiRelClass;
    insClasses: REF InsClasses ~ NEW [InsClasses];

    InsPrimitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANY _ NIL] RETURNS [PrimitiveAnswer] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        SELECT op FROM
            $AsSet, $HasPair, $Image, $Apply, $ScanRestriction, $Get3, $Index, $RestrictionSize, $GetBounds, $Copy, $ValueOf, $SetOn, 
            $CurSetOn, $Update, $Spaces, $IsDense, $SideFixed => RETURN [IF rbr^.Primitive[op, arg1, arg2] THEN yes ELSE no];
            $GetOne => {
                remove: BOOL ~ ToBool[arg1];
                RETURN [IF remove OR rbr^.GoodImpl[op, arg1, arg2] THEN yes ELSE no]};
            ENDCASE => RETURN [no];
        };

    InsAsSet: PROC [br: BiRel, ro: RelOrder] RETURNS [Set--of REF Pair--] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.Insulate.AsSet[ro]};

    InsHasPair: PROC [br: BiRel, pair: Pair] RETURNS [BOOL] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.HasPair[pair]};

    InsImage: PROC [br: BiRel, set: Set, dir: Direction] RETURNS [Set] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN [rbr^.Image[set, dir].Insulate]};

    InsApply: PROC [br: BiRel, v: Value, dir: Direction] RETURNS [MaybeValue] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.Apply[v, dir]};

    InsScanRestriction: PROC [br: BiRel, sets: SetPair, Test: Tester, ro: RelOrder] RETURNS [MaybePair] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.ScanRestriction[sets, Test, ro]};

    InsGetOne: PROC [br: BiRel, remove: BOOL, ro: RelOrder] RETURNS [MaybePair] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        IF remove THEN br.Complain[notVariable];
        RETURN rbr^.GetOne[remove, ro]};

    InsGet3: PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool] RETURNS [TripleMaybePair] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.Get3[pair, ro, want]};

    InsIndex: PROC [br, goal: IntRel, bounds: IntInterval, bwd: BOOL] RETURNS [MaybeValue] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.Index[goal, bounds, bwd]};

    InsRestrictionSize: PROC [br: BiRel, sets: SetPair, limit: EINT] RETURNS [EINT] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.RestrictionSize[sets, limit]};

    InsGetBounds: PROC [br: BiRel, want: EndBools, ro: RelOrder] RETURNS [MaybePairInterval] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.GetBounds[want, ro]};

    InsCopy: PROC [br: BiRel] RETURNS [VarBiRel] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.Copy};

    InsValueOf: PROC [br: BiRel] RETURNS [ConstBiRel] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.ValueOf};

    InsSetOn: PROC [br: BiRel, side: Side] RETURNS [UWSet] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.SetOn[side]};

    InsCurSetOn: PROC [br: BiRel, side: Side] RETURNS [ConstSet] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.CurSetOn[side]};

    InsUpdate: PROC [br: BiRel, val: Value, dir: Direction, Decide: UpdateDecider] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        InsulateDecide: PROC [old: MaybeValue] RETURNS [new: MaybeValue] ~ {
            new _ Decide[old];
            IF NOT (new=old OR new.found AND old.found AND rbr^.Spaces[][Dest[dir]].SEqual[old.it, new.it] OR (NOT new.found) AND (NOT 
            old.found)) THEN br.Complain[notVariable];
            RETURN};
        rbr^.Update[val, dir, InsulateDecide];
        RETURN};

    InsSpaces: PROC [br: BiRel] RETURNS [SpacePair] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.Spaces[]};

    InsIsDense: PROC [br: BiRel, when: When, side: Side] RETURNS [BOOL] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.IsDense[when, side]};

    InsSideFixed: PROC [br: BiRel, side: Side] RETURNS [BOOL] ~ {
        rbr: REF BiRel ~ NARROW[br.data];
        RETURN rbr^.SideFixed[side]};

    DefaultRemPair: PUBLIC PROC [br: BiRel, pair: Pair] RETURNS [had: HadPair _ ALL[same]] ~ {
        spaces: SpacePair ~ br.Spaces[];
        IF br.MutabilityOf[]#variable THEN br.Complain[notVariable];
        IF br.Functional[] # ALL[FALSE] THEN FOR dir: Direction IN Direction DO
            IF NOT br.Functional[][dir] THEN NULL
            ELSE IF Primitive[br, $Update, FromDir[dir]] THEN {
                dest: Side ~ Dest[dir];
                DecideToRem: PROC [omv: MaybeValue] RETURNS [MaybeValue] ~ {
                    had[dir] _ IF omv.found THEN IF spaces[dest].SEqual[pair[dest], omv.it] THEN same ELSE different ELSE none;
                    IF dir=Direction.FIRST AND br.Functional[][Direction.LAST] THEN RETURN [omv];
                    RETURN [IF had[dir]=same THEN noMaybe ELSE omv]};
                br.Update[pair[Source[dir]], dir, DecideToRem];
                had _ had}
            ELSE EXIT;
            REPEAT FINISHED => RETURN;
            ENDLOOP;
        IF Primitive[br, $RemSet, FakeRefSingleton[spaces]] THEN RETURN [UnSetHads[br.class.RemSet[br, CreateSingleton[pair, spaces]]]];
        IF br.Functional[]#ALL[FALSE] THEN {
            goodDelete: BoolPair _ ALL[FALSE];
            FOR dir: Direction IN Direction DO
                src: Side ~ Source[dir];
                dst: Side ~ Dest[dir];
                IF br.Functional[][dir] THEN {
                    IF br.GoodImpl[$Apply, FromDir[dir]] THEN {
                        map: MaybeValue ~ br.Apply[pair[src], dir];
                        had[dir] _ IF map.found THEN IF spaces[dst].SEqual[pair[dst], map.it] THEN same ELSE different ELSE none;
                        goodDelete[dir] _ br.Primitive[$Delete, FromSide[src]] OR br.Primitive[$DeleteSet, Sets.FakeRefSingleton[spaces[src]], 
                        FromSide[src]]}
                    ELSE {had _ had; GOTO NoGood}};
                ENDLOOP;
            IF goodDelete=ALL[FALSE] THEN GOTO NoGood;
            {side: Side ~ IF goodDelete[leftToRight] THEN left ELSE right;
            IF had[From[side]]=same THEN {IF NOT br.Delete[pair[side], side] THEN ERROR};
            RETURN};
            EXITS NoGood => had _ had};
        br.Cant[]};

    DefaultRemSet: PUBLIC PROC [br, other: BiRel] RETURNS [some: HadSetPair _ ALL[ALL[FALSE]]] ~ {
        RemThisPair: PROC [pair: Pair] RETURNS [BOOL] ~ {
            had: HadPair ~ br.RemPair[pair];
            some[leftToRight][had[leftToRight]] _ TRUE;
            some[rightToLeft][had[rightToLeft]] _ TRUE;
            RETURN [FALSE]};
        IF br.MutabilityOf[]#variable THEN br.Complain[notVariable];
        IF br.Primitive[$RemPair] THEN {IF other.Scan[RemThisPair].found THEN ERROR; RETURN};
        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 => {IF other.Scan[RemThisPair].found THEN ERROR; RETURN};
                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 {IF other.Scan[RemThisPair].found THEN ERROR; RETURN};
                ENDLOOP;
            some _ some}};
        br.Cant[]};

    DefaultDelete: PUBLIC PROC [br: BiRel, val: Value, side: Side] RETURNS [hadSome: BOOL _ FALSE] ~ {
        srcSpace: Space ~ br.Spaces[][side];
        dir: Direction ~ From[side];
        IF br.MutabilityOf[]#variable THEN br.Complain[notVariable];
        IF br.Functional[][dir] AND Primitive[br, $Update, FromDir[dir]] THEN {
            DecideToDelete: PROC [omv: MaybeValue] RETURNS [MaybeValue] ~ {
                hadSome _ omv.found;
                RETURN [noMaybe]};
            br.Update[val, dir, DecideToDelete];
            RETURN};
        IF Primitive[br, $DeleteSet, Sets.FakeRefSingleton[srcSpace], FromSide[side]]
            THEN RETURN [br.class.DeleteSet[br, Sets.CreateSingleton[val, srcSpace], side].had.some];
        {other: Side ~ OtherSide[side];
        pair: Pair _ ALL[val];
        KillPair: PROC [v2: Value] RETURNS [BOOL] ~ {
            pair[other] _ v2;
            [] _ br.RemPair[pair];
            hadSome _ TRUE;
            RETURN [FALSE]};
        IF br.ScanMapping[val, KillPair, dir].found THEN ERROR;
        RETURN}};

    DefaultDeleteSet: PUBLIC PROC [br: BiRel, set: Set, side: Side] RETURNS [had: SomeAll _ []] ~ {
        other: Side ~ OtherSide[side];
        dir: Direction ~ From[side];
        easy: BOOL ~ Primitive[br, $Delete, FromSide[side]] OR br.Functional[][dir] AND Primitive[br, $Update, FromDir[dir]];
        EasyKill: PROC [val: Value] RETURNS [BOOL] ~ {
            IF br.Delete[val, side] THEN had.some _ TRUE ELSE had.all _ FALSE;
            RETURN [FALSE]};
        HardKill: PROC [val: Value] RETURNS [BOOL] ~ {
            pair: Pair _ ALL[val];
            HardKillPair: PROC [v2: Value] RETURNS [BOOL] ~ {
                pair[other] _ v2;
                [] _ br.RemPair[pair];
                some _ TRUE;
                RETURN [FALSE]};
            some: BOOL _ FALSE;
            IF br.ScanMapping[val, HardKillPair, dir].found THEN ERROR;
            IF some THEN had.some _ TRUE ELSE had.all _ FALSE;
            RETURN [FALSE]};
        IF br.MutabilityOf[]#variable THEN br.Complain[notVariable];
        IF set.Scan[IF easy THEN EasyKill ELSE HardKill].found THEN ERROR;
        RETURN};

    DefaultUpdate: PUBLIC PROC [br: BiRel, val: Value, dir: Direction, Decide: UpdateDecider] ~ {
        IF NOT br.class.functional[dir] THEN br.Complain[notFunctional, LIST[AV[NEW [Direction _ dir]]]];
        {old: MaybeValue ~ br.Apply[val, dir];
        new: MaybeValue ~ Decide[old];
        dest: Side ~ Dest[dir];
        IF old=new THEN RETURN;
        IF new.found THEN {IF NOT (old.found AND br.Spaces[][dest].SEqual[old.it, new.it]) THEN [] _ br.AddPair[Cons[dest, new.it, val]]}
        ELSE IF old.found THEN [] _ br.RemPair[Cons[dest, old.it, val]];
        RETURN}};

    Start: PROC ~ {
        FOR l2r: BOOL IN BOOL DO FOR r2l: BOOL IN BOOL DO
            insClasses[l2r][r2l] _ CreateClass[[
                Primitive: InsPrimitive,
                AsSet: InsAsSet,
                HasPair: InsHasPair,
                Image: InsImage,
                Apply: InsApply,
                ScanRestriction: InsScanRestriction,
                GetOne: InsGetOne,
                Get3: InsGet3,
                Index: InsIndex,
                RestrictionSize: InsRestrictionSize,
                GetBounds: InsGetBounds,
                Copy: InsCopy,
                ValueOf: InsValueOf,
                SetOn: InsSetOn,
                CurSetOn: InsCurSetOn,
                Update: InsUpdate,
                Spaces: InsSpaces,
                IsDense: InsIsDense,
                SideFixed: InsSideFixed,
                functional: [l2r, r2l],
                mutability: readonly]];
            ENDLOOP ENDLOOP;
        RETURN};

    Start[];

    END.