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ЪЭЬШЧ ЕЧ    и   Я  