DIRECTORY Atom, BiRels, IntStuff, SetBasics, AbSets; BiRelShifting: CEDAR PROGRAM IMPORTS BiRels, IntStuff, SetBasics, AbSets EXPORTS BiRels = BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRels; ShiftClip: TYPE ~ REF ShiftClipPrivate; ShiftClipPrivate: TYPE ~ RECORD [ es: ARRAY Direction OF EINT, cs: ARRAY Side OF IntInterval ]; Restrict: PROC [sc: ShiftClip, sets: SetPair] RETURNS [left: IntInterval] ~ { RETURN [Intersect[ IF sets[left]#nilSet THEN sets[left].AsIntInterval ELSE [], IF sets[right]#nilSet THEN sets[right].AsIntInterval.Intersect[sc.cs[right]] .ShiftInterval[sc.es[rightToLeft]] ELSE sc.cs[left]]]}; ShiftAndClip: PUBLIC PROC [br: IntRel, shift: EINT _ zero, clip: IntInterval _ []] RETURNS [IntRel] ~ { IF shift = zero AND clip = [] THEN RETURN [br]; {good: BOOL ~ br.GoodImpl[$GetIntDom]; dom: IntInterval ~ IF good THEN br.GetIntDom ELSE []; li: IntInterval ~ clip.ClipShiftInterval[shift.Neg]; ri: IntInterval ~ li.ShiftInterval[shift]; scr: BiRel ~ CreateShiftAndClipper[shift.Neg, li]; mbi: IntInterval ~ ri.MBI[dom]; RETURN Compose[scr, br, IF NOT good THEN ALL[TRUE] ELSE IF mbi=ri THEN IF mbi=dom THEN ALL[FALSE] ELSE [FALSE, TRUE] ELSE IF mbi=dom THEN [TRUE, FALSE] ELSE ALL[TRUE]]}}; CreateShiftAndClipper: PUBLIC PROC [shift: EINT _ zero, clip: IntInterval _ []] RETURNS [ConstOneToOne] ~ { e: EINT ~ shift; ne: EINT ~ e.Neg; cr: IntInterval ~ clip.ClipShiftInterval[e]; IF cr.Empty[] THEN RETURN [CreateEmptyBiRel[ALL[ints]]]; IF cr.min=cr.max THEN RETURN CreateSingleton[[[i[ne.AddI[cr.min].EI]], [i[cr.min]]], ALL[ints]]; {sc: ShiftClip ~ NEW [ShiftClipPrivate _ [ es: [e, ne], cs: [left: cr.ShiftInterval[ne], right: cr] ]]; RETURN AsConst[[scClass, sc]]}}; scClass: BiRelClass ~ CreateClass[ cp: [ Primitive: SCPrimitive, HasPair: SCHasPair, Image: SCImage, Apply: SCApply, ScanRestriction: SCScanRestriction, Get3: SCGet3, RestrictionSize: SCRestrictionSize, GetBounds: SCGetBounds, SetOn: SCSetOn, Spaces: SCSpaces, IsDense: SCIsDense, functional: ALL[TRUE], mutability: constant], dirable: ALL[TRUE]]; SCPrimitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANY _ NIL] RETURNS [PrimitiveAnswer] ~ { SELECT op FROM $Image => {sc: ShiftClip ~ NARROW[br.data]; rs: RefSet ~ ToSet[arg1]; RETURN [IF (rs^.GoodImpl[$QuaIntInterval] AND rs^.QuaIntInterval[].found) THEN yes ELSE no]}; ENDCASE => RETURN [pass]}; SCHasPair: PROC [br: BiRel, pair: Pair] RETURNS [BOOL] ~ { sc: ShiftClip ~ NARROW[br.data]; WITH pair[left] SELECT FROM x: IntValue => RETURN [x.i IN [sc.cs[left].min .. sc.cs[left].max] AND (WITH pair[right] SELECT FROM y: IntValue => sc.es[leftToRight].AddI[x.i]=IE[y.i], ENDCASE => FALSE)]; ENDCASE => RETURN [FALSE]}; SCImage: PROC [br: BiRel, set: Set, dir: Direction] RETURNS [Set] ~ { IF set.MutabilityOf[]#constant THEN GOTO GiveUp; IF NOT set.GoodImpl[$QuaIntInterval] THEN GOTO GiveUp; {sc: ShiftClip ~ NARROW[br.data]; qi: MaybeIntInterval ~ set.QuaIntInterval[]; IF NOT qi.found THEN GOTO GiveUp; RETURN [IIAsSet[qi.it.ClipShiftInterval[sc.es[dir]]]]}; EXITS GiveUp => RETURN DefaultImage[br, set, dir]}; SCApply: PROC [br: BiRel, v: Value, dir: Direction] RETURNS [MaybeValue] ~ { sc: ShiftClip ~ NARROW[br.data]; WITH v SELECT FROM x: IntValue => { c: IntInterval ~ sc.cs[Source[dir]]; RETURN [IF x.i IN [c.min .. c.max] THEN [TRUE, [i[sc.es[dir].AddI[x.i].EI]]] ELSE noMaybe]; }; ENDCASE => RETURN [noMaybe]}; SCScanRestriction: PROC [br: BiRel, sets: SetPair, Test: Tester, ro: RelOrder] RETURNS [MaybePair] ~ { sc: ShiftClip ~ NARROW[br.data]; li: IntInterval ~ Restrict[sc, sets]; IF NOT li.Empty THEN SELECT ro.sub[ro.first] FROM fwd, no => { i: INT _ li.min; j: INT _ sc.es[leftToRight].AddI[i].EI; DO IF Test[[[i[i]], [i[j]]]] THEN RETURN [[TRUE, [[i[i]], [i[j]]]]]; IF i=li.max THEN EXIT; i _ i + 1; j _ j + 1; ENDLOOP}; bwd => { i: INT _ li.max; j: INT _ sc.es[leftToRight].AddI[i].EI; DO IF Test[[[i[i]], [i[j]]]] THEN RETURN [[TRUE, [[i[i]], [i[j]]]]]; IF i=li.min THEN EXIT; i _ i - 1; j _ j - 1; ENDLOOP}; ENDCASE => ERROR; RETURN [noMaybePair]}; MaybeInt: TYPE ~ RECORD [found: BOOL, it: INT]; SCGet3: PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool] RETURNS [TripleMaybePair] ~ { sc: ShiftClip ~ NARROW[br.data]; i: INT ~ pair[ro.first].VI; c: IntInterval ~ sc.cs[ro.first]; Ex: PROC [mi: MaybeInt] RETURNS [MaybePair] ~ { RETURN [SELECT ro.first FROM left => IF mi.found THEN [TRUE, [[i[mi.it]], [i[sc.es[leftToRight].AddI[mi.it].EI]]]] ELSE noMaybePair, right => IF mi.found THEN [TRUE, [[i[sc.es[rightToLeft].AddI[mi.it].EI]], [i[mi.it]]]] ELSE noMaybePair, ENDCASE => ERROR]}; Finish: PROC [l, e, g: MaybeInt] RETURNS [TripleMaybePair] ~ { SELECT ro.sub[ro.first] FROM fwd, no => RETURN [[Ex[l], Ex[e], Ex[g]]]; bwd => RETURN [[Ex[g], Ex[e], Ex[l]]]; ENDCASE => ERROR}; SELECT TRUE FROM i < c.min => RETURN Finish[[FALSE, 0], [FALSE, 0], [TRUE, c.min]]; i = c.min => RETURN Finish[[FALSE, 0], [TRUE, i], [TRUE, i+1]]; i < c.max => RETURN Finish[[TRUE, i-1], [TRUE, i], [TRUE, i+1]]; i = c.max => RETURN Finish[[TRUE, i-1], [TRUE, i], [FALSE, 0]]; ENDCASE => RETURN Finish[[FALSE, c.max], [FALSE, 0], [TRUE, 0]]}; SCRestrictionSize: PROC [br: BiRel, sets: SetPair, limit: EINT] RETURNS [EINT] ~ { sc: ShiftClip ~ NARROW[br.data]; li: IntInterval ~ Restrict[sc, sets]; RETURN li.Length[]}; SCGetBounds: PROC [br: BiRel, want: EndBools, ro: RelOrder] RETURNS [MaybePairInterval] ~ { sc: ShiftClip ~ NARROW[br.data]; RETURN [[TRUE, SELECT ro.sub[ro.first] FROM fwd, no => [ min: [[i[sc.cs[left].min]], [i[sc.cs[right].min]] ], max: [[i[sc.cs[left].max]], [i[sc.cs[right].max]] ]], bwd => [ max: [[i[sc.cs[left].min]], [i[sc.cs[right].min]] ], min: [[i[sc.cs[left].max]], [i[sc.cs[right].max]] ]], ENDCASE => ERROR]]}; SCSetOn: PROC [br: BiRel, side: Side] RETURNS [UWSet] ~ { sc: ShiftClip ~ NARROW[br.data]; RETURN [IIAsSet[sc.cs[side]]]}; SCSpaces: PROC [br: BiRel] RETURNS [SpacePair] ~ {RETURN [ALL[ints]]}; SCIsDense: PROC [br: BiRel, when: When, side: Side] RETURNS [BOOL] ~ {RETURN [TRUE]}; Start: PROC ~ { RETURN}; Start[]; END. \BiRelShifting.Mesa Last tweaked by Mike Spreitzer on December 14, 1987 1:14:10 pm PST Κ›– "cedar" style˜codešœ™KšœB™B—K˜KšΟk œ+˜4K˜šΟn œœ˜Kšœ$˜+Kšœ˜K˜—K˜Kšœœžœ˜:K˜Kšœ œœ˜'šœœœ˜!Kšœœ œœ˜Kšœœœ ˜Kšœ˜—K˜šžœœ œ˜Mšœ ˜Kšœœœ˜;šœ˜KšœU˜YKšœ˜———K˜š ž œœœœ!œ ˜gKšœœ œœ˜/Kšœœ˜&Kšœœœœ˜5Kšœ4˜4K˜*Kšœ2˜2Kšœœ˜šœ˜Kš œœœœœ˜Kšœœœœ œœœœœœ˜AKšœœ œœœœœœ˜5——K˜š žœœœ œ!œ˜kKšœœ ˜Kšœœ ˜Kšœ,˜,Kšœ œœœ ˜8Kš œœœ%œœ˜`šœœ˜*K˜ K˜+K˜—Kšœ˜ —K˜˜"˜Kšž œ˜Kšžœ ˜Kšžœ ˜Kšžœ ˜Kšžœ˜#Kšžœ ˜ Kšžœ˜#Kšž œ˜Kšžœ ˜Kšžœ ˜Kšžœ ˜Kšœ œœ˜K˜—Kšœ œœ˜—K˜šž œœœœœœœ˜`šœ˜šœœ ˜+K˜Kš œœ œœœ˜]—Kšœœ ˜——K˜šž œœœœ˜:Kšœœ ˜ šœ œ˜š œœœ&œœ œ˜dKšœ,œ˜4Kšœœ˜—Kšœœœ˜——K˜šžœœ'œ ˜EKšœœœ˜0Kšœœœœ˜6Kšœœ ˜!Kšœ,˜,Kšœœ œœ˜!Kšœ1˜7Kšœ œ˜3—K˜šžœœ'œ˜LKšœœ ˜ šœœ˜šœ˜Kšœ$˜$Kšœœœœœœœ ˜[Kšœ˜—Kšœœ ˜——K˜šžœœžœœ˜fKšœœ ˜ Kšœ%˜%š œœ œœ˜1šœ ˜ Kšœœ ˜Kšœœœ˜'š˜Kšœœœœ˜AKšœ œœ˜K˜ K˜ Kšœ˜ ——šœ˜Kšœœ ˜Kšœœœ˜'š˜Kšœœœœ˜AKšœ œœ˜K˜ K˜ Kšœ˜ ——Kšœœ˜—Kšœ˜—K˜Kš œ œœ œœ˜/K˜šžœœ9œ˜bKšœœ ˜ Kšœœœ˜Kšœ!˜!šžœœœ˜/šœœ ˜Kš œœ œœ1œœ ˜gKš œ œ œœ%œœ ˜hKšœœ˜——šžœœœ˜>šœ˜Kšœ œ˜*Kšœœ˜&Kšœœ˜——šœœ˜Kš œ œ œœœ ˜BKš œ œ œœœ˜?Kš œ œ œ œœ˜@Kš œ œ œ œœ˜?Kš œœ œ œœ˜A——K˜š žœœ#œœœ˜RKšœœ ˜ Kšœ%˜%Kšœ˜—K˜šž œœ+œ˜[Kšœœ ˜ šœœœ˜+˜ K˜4K˜5—˜K˜4K˜5—Kšœœ˜——K˜šžœœœ ˜9Kšœœ ˜ Kšœ˜—K˜Kš žœœ œœœ ˜FK˜šž œœ%œœ˜BKšœœœ˜—K˜šžœœ˜Kšœ˜—K˜K˜K˜Kšœ˜—…—¨ Ÿ