<> <> DIRECTORY AbSets, Atom, BiRelBasics, BiRels, BiRelsPrivate, IntStuff, List, SetBasics; BiRelDefaults: CEDAR PROGRAM IMPORTS AbSets, BiRelBasics, BiRels, BiRelsPrivate, IntStuff, SetBasics EXPORTS BiRels = BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels, BiRelsPrivate; DefaultHasPair: PUBLIC PROC [br: BiRel, pair: Pair] RETURNS [BOOL] ~ { spaces: SpacePair ~ br.Spaces[]; RETURN [br.ScanRestriction[[Sets.CreateSingleton[pair[left], spaces[left]], Sets.CreateSingleton[pair[right], spaces[right]]], AcceptAny].found]}; DefaultApply: PUBLIC PROC [br: BiRel, v: Value, dir: Direction] RETURNS [mv: MaybeValue _ noMaybe] ~ { src: Side ~ Source[dir]; dst: Side ~ Dest[dir]; n: LNAT _ 0; Test: PROC [pair: Pair] RETURNS [BOOL] ~ { IF (n _ n + 1) > 1 THEN br.Complain[mappingNotSingleton, LIST[v]]; TRUSTED {mv _ [TRUE, pair[dst]]}; RETURN [FALSE]}; [] _ br.ScanRestriction[ConsSets[src, Sets.CreateSingleton[v, br.Spaces[][src]]], Test]; RETURN}; ImageSize: PUBLIC PROC [br: BiRel, set: Set, dir: Direction _ leftToRight, limit: EINT _ lastEINT] RETURNS [EINT] ~ { easy: BOOL ~ set.GoodImpl[$Size] AND set.Size[two].Compare[two] IF (NOT prev.found) OR ro.RelPCompare[spaces, this, prev.it]=greater THEN prev _ [TRUE, this]; equal => foundSame _ TRUE; greater => IF (NOT next.found) OR ro.RelPCompare[spaces, this, next.it]=less THEN next _ [TRUE, this]; notrel => NULL; ENDCASE => ERROR; RETURN}; IF br.Scan[Test].found THEN ERROR; RETURN [[prev, IF foundSame THEN [TRUE, pair] ELSE noMaybePair, next]]}; }}}; DefaultIndex: PUBLIC PROC [br, goal: IntRel, bounds: IntInterval, bwd: BOOL] RETURNS [MaybeValue] ~ { ENABLE Cant => Cant[br]; right: Space ~ br.Spaces[][right]; brBounds: IntInterval ~ IF br.GoodImpl[$GetIntDom] THEN br.GetIntDom[] ELSE []; goalBounds: IntInterval ~ goal.GetIntDom[]; goalLen: EINT ~ goalBounds.Length; first: Set ~ IF goalBounds.Empty THEN nilSet ELSE goal.Mapping[[i[goalBounds.min]]]; scanBounds: IntInterval ~ Intersect[ <<>> <<>> bounds.ClipShiftInterval[IE[goalBounds.min]], brBounds.ClipShiftInterval[one.Sub[goalLen]]]; Try: PROC [i: INT] RETURNS [BOOL] ~ { IF first.Equal[br.Mapping[[i[i]]]] THEN { d: EINT ~ ISub[i, goalBounds.min]; FOR j: INT IN (goalBounds.min .. goalBounds.max] DO fm: Set ~ br.Mapping[[i[d.AddI[j].EI]]]; gm: Set ~ goal.Mapping[[i[j]]]; IF NOT fm.Equal[gm] THEN RETURN [FALSE]; ENDLOOP; RETURN [TRUE]}; RETURN [FALSE]}; IF goal.Empty THEN RETURN [[TRUE, [i[IF bwd THEN bounds.max ELSE bounds.min]]]]; IF bwd THEN FOR i: INT DECREASING IN [scanBounds.min .. scanBounds.max] DO IF Try[i] THEN RETURN [[TRUE, [i[i - goalBounds.min]] ]]; ENDLOOP ELSE FOR i: INT IN [scanBounds.min .. scanBounds.max] DO IF Try[i] THEN RETURN [[TRUE, [i[i - goalBounds.min]] ]]; ENDLOOP; RETURN [noMaybe]}; DefaultRestrictionSize: PUBLIC PROC [br: BiRel, sets: SetPair, limit: EINT] RETURNS [size: EINT _ zero] ~ { Pass: PROC [pair: Pair] RETURNS [pass: BOOL] ~ TRUSTED {pass _ limit.Compare[size _ size.Succ[]] <= equal; RETURN}; [] _ br.ScanRestriction[sets, Pass]; RETURN}; DefaultGetBounds: PUBLIC PROC [br: BiRel, want: EndBools, ro: RelOrder] RETURNS [MaybePairInterval] ~ { IF want = ALL[FALSE] THEN RETURN [[FALSE, []]]; ro _ ro.CanonizeRelOrder[br.Functional[]]; {rro: RelOrder ~ ro.ReverseRO[]; IF ((NOT want[min]) OR Primitive[br, $ScanRestriction, fromNils, FromRO[ro]]) AND ((NOT want[max]) OR Primitive[br, $ScanRestriction, fromNils, FromRO[rro]]) THEN TRUSTED { bnds: PairInterval; FOR e: End IN End DO IF want[e] THEN { mp: MaybePair _ br.APair[IF e=min THEN ro ELSE rro]; IF NOT mp.found THEN GOTO Empty; bnds[e] _ mp.it}; ENDLOOP; RETURN [[TRUE, bnds]]} ELSE { spaces: SpacePair ~ br.Spaces[]; bnds: PairInterval _ ALL[ALL[noValue]]; first: BOOL _ TRUE; Test: PROC [pair: Pair] RETURNS [BOOL] ~ TRUSTED { IF first THEN {first _ FALSE; bnds _ [pair, pair]} ELSE { IF want[min] THEN bnds[min] _ ro.RMin[spaces, bnds[min], pair]; IF want[max] THEN bnds[max] _ ro.RMax[spaces, bnds[max], pair]}; RETURN [FALSE]}; IF br.Scan[Test].found THEN ERROR; IF first THEN GOTO Empty; RETURN [[TRUE, bnds]]}; EXITS Empty => RETURN [[FALSE, []]]; }}; fromNils: REF ANY ~ FromSets[[]]; DefaultCopy: PUBLIC PROC [br: BiRel] RETURNS [VarBiRel] ~ {br.Cant[]}; DefaultValueOf: PUBLIC PROC [br: BiRel] RETURNS [ConstBiRel] ~ {IF br.MutabilityOf#constant THEN RETURN br.Copy.Freeze[] ELSE RETURN br.AsConst[]}; DefaultFreeze: PUBLIC PROC [br: BiRel] RETURNS [ConstBiRel] ~ { IF br.MutabilityOf#variable THEN br.Complain[notVariable] ELSE br.Cant[]; ERROR}; DefaultThaw: PUBLIC PROC [br: BiRel] ~ { IF br.MutabilityOf#variable THEN br.Complain[notVariable] ELSE br.Cant[]}; DefaultSetOn: PUBLIC PROC [br: BiRel, side: Side] RETURNS [UWSet] ~ { RETURN br.Image[CreateFullSet[br.Spaces[][OtherSide[side]]], To[side]].Insulate}; DefaultCurSetOn: PUBLIC PROC [br: BiRel, side: Side] RETURNS [ConstSet] ~ { IF br.MutabilityOf=constant THEN RETURN br.SetOn[side].AsConst ELSE br.Cant}; DefaultAddPair: PUBLIC PROC [br: BiRel, pair: Pair, if: IfHadPair] RETURNS [had: HadPair] ~ { spaces: SpacePair ~ br.Spaces[]; IF Primitive[br, $AddSet, FakeRefSingleton[spaces]] THEN RETURN [UnSetHads[br.AddSet[CreateSingleton[pair, spaces], if] ]]; br.Cant[]}; DefaultAddSet: PUBLIC PROC [br, other: BiRel, if: IfHadPair] RETURNS [some: HadSetPair _ ALL[ALL[FALSE]]] ~ { AddThisPair: PROC [pair: Pair] RETURNS [BOOL] ~ { had: HadPair ~ br.AddPair[pair, if]; some[leftToRight][had[leftToRight]] _ TRUE; some[rightToLeft][had[rightToLeft]] _ TRUE; RETURN [FALSE]}; IF NOT Primitive[br, $AddPair] THEN br.Cant[]; IF other.Scan[AddThisPair].found THEN ERROR; RETURN}; DefaultSwap: PUBLIC PROC [br: BiRel, a, b: Value, side: Side] ~ TRUSTED { spaces: SpacePair ~ br.Spaces[]; IF spaces[side].SEqual[a, b] THEN RETURN; {dir: Direction ~ From[side]; other: Side ~ OtherSide[side]; am: Set ~ br.Mapping[a, dir].CreateHashCopy[]; patt: Pair _ ALL[a]; Movit: PROC [v: Value] RETURNS [BOOL] ~ TRUSTED { patt[other] _ v; [] _ br.AddPair[patt]; RETURN [FALSE]}; [] _ br.Delete[a, side]; IF br.ScanMapping[b, Movit, dir].found THEN ERROR; [] _ br.Delete[b, side]; patt _ ALL[b]; IF am.Scan[Movit].found THEN ERROR; RETURN}}; DefaultRemPair: PUBLIC PROC [br: BiRel, pair: Pair] RETURNS [had: HadPair] ~ { spaces: SpacePair ~ br.Spaces[]; IF Primitive[br, $RemSet, FakeRefSingleton[spaces]] THEN RETURN [UnSetHads[br.class.RemSet[br, CreateSingleton[pair, spaces]]]]; br.Cant[]}; DefaultRemSet: PUBLIC PROC [br, other: BiRel] RETURNS [some: HadSetPair] ~ { RemThisPair: PROC [pair: Pair] RETURNS [BOOL] ~ { had: HadPair ~ br.RemPair[pair]; some[leftToRight][had[leftToRight]] _ TRUE; some[rightToLeft][had[rightToLeft]] _ TRUE; RETURN [FALSE]}; IF NOT Primitive[br, $RemPair] THEN br.Cant[]; IF other.Scan[RemThisPair].found THEN ERROR; RETURN}; DefaultDelete: PUBLIC PROC [br: BiRel, val: Value, side: Side] RETURNS [hadSome: BOOL _ FALSE] ~ { srcSpace: Space ~ br.Spaces[][side]; 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]; dir: Direction ~ From[side]; pair: Pair _ ALL[val]; KillPair: PROC [v2: Value] RETURNS [BOOL] ~ TRUSTED { 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]]; 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] ~ TRUSTED { 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 set.Scan[IF easy THEN EasyKill ELSE HardKill].found THEN ERROR; RETURN}; END.