
    <<BiRelCombining2.Mesa>>
        <<Last tweaked by Mike Spreitzer on December 15, 1987 4:41:14 pm PST>>

    DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, SetBasics;

    BiRelCombining2: CEDAR PROGRAM
        IMPORTS AbSets, BiRels, SetBasics
        EXPORTS BiRels
        =

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

    Difference: PUBLIC PROC [a, b: BiRel] RETURNS [UWBiRel] ~ {
        RETURN a.Intersection[b.Negate]};

    SymmetricDifference: PUBLIC PROC [a, b: BiRel] RETURNS [c: UWBiRel] ~ {
        RETURN a.Difference[b].Union[b: b.Difference[a], disjoint: TRUE]};

    Negate: PUBLIC PROC [br: BiRel] RETURNS [BiRel] ~ {
        class: BiRelClass ~ negClasses[br.MutabilityOf];
        IF br.class=class THEN RETURN DeRef[br.data];
        RETURN [[class, br.Refify]]};

    NegClasses: TYPE ~ ARRAY Mutability OF BiRelClass;
    negClasses: REF NegClasses ~ NEW [NegClasses];

    NegPrimitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANY _ NIL] RETURNS [PrimitiveAnswer] ~ {
        rbr: RefBiRel ~ NARROW[br.data];
        SELECT op FROM
            $AsSet, $HasPair, $Copy, $Insulate, $ValueOf, $Freeze, $Thaw, $Swap, $SideFixed => RETURN [IF rbr^.GoodImpl[op, arg1, arg2] THEN 
            yes ELSE no];
            $AddSet => RETURN [IF rbr^.GoodImpl[$RemSet, arg1, arg2] THEN yes ELSE no];
            $RemSet => RETURN [IF rbr^.GoodImpl[$AddSet, arg1, arg2] THEN yes ELSE no];
            ENDCASE => RETURN [no];
        };

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

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

    NegCopy: PROC [br: BiRel] RETURNS [VarBiRel] ~ {
        rbr: RefBiRel ~ NARROW[br.data];
        RETURN rbr^.Copy.Negate.AsVar};

    NegInsulate: PROC [br: BiRel] RETURNS [UWBiRel] ~ {
        rbr: RefBiRel ~ NARROW[br.data];
        RETURN rbr^.Insulate.Negate.AsUW};

    NegValueOf: PROC [br: BiRel] RETURNS [ConstBiRel] ~ {
        rbr: RefBiRel ~ NARROW[br.data];
        RETURN rbr^.ValueOf.Negate.AsConst};

    NegFreeze: PROC [br: BiRel] RETURNS [ConstBiRel] ~ {
        rbr: RefBiRel ~ NARROW[br.data];
        RETURN rbr^.Freeze.Negate.AsConst};

    NegThaw: PROC [br: BiRel] ~ {
        rbr: RefBiRel ~ NARROW[br.data];
        rbr^.Thaw; RETURN};

    NegAddSet: PROC [br, other: BiRel, if: IfHadPair] RETURNS [some: HadSetPair _ []] ~ {
        rbr: RefBiRel ~ NARROW[br.data];
        negHad: HadSetPair ~ rbr^.RemSet[other];
        RETURN};

    NegSwap: PROC [br: BiRel, a, b: Value, side: Side] ~ {
        rbr: RefBiRel ~ NARROW[br.data];
        rbr^.Swap[a, b, side]; RETURN};

    NegRemSet: PROC [br, other: BiRel] RETURNS [some: HadSetPair _ []] ~ {
        rbr: RefBiRel ~ NARROW[br.data];
        negHad: HadSetPair ~ rbr^.AddSet[other];
        RETURN};

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

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

    Start: PROC ~ {
        FOR mut: Mutability IN Mutability DO
            negClasses[mut] _ CreateClass[[
                Primitive: NegPrimitive,
                AsSet: NegAsSet,
                HasPair: NegHasPair,
                Copy: NegCopy,
                Insulate: IF mut=variable THEN NegInsulate ELSE NIL,
                ValueOf: IF mut#constant THEN NegValueOf ELSE NIL,
                Freeze: IF mut=variable THEN NegFreeze ELSE NIL,
                Thaw: IF mut=variable THEN NegThaw ELSE NIL,
                AddSet: IF mut=variable THEN NegAddSet ELSE NIL,
                Swap: IF mut=variable THEN NegSwap ELSE NIL,
                RemSet: IF mut=variable THEN NegRemSet ELSE NIL,
                Spaces: NegSpaces,
                SideFixed: NegSideFixed,
                functional: ALL[FALSE],
                mutability: mut]];
            ENDLOOP;
        };

    Start[];

    END.