DIRECTORY Basics, Collections, IntFunctions, IntStuff, PairCollections;

StdIntFunctions2: CEDAR PROGRAM
IMPORTS Collections, IntFunctions, IntStuff, PairCollections
EXPORTS PairCollections
=

BEGIN OPEN PCs:PairCollections, Colls:Collections, Ints:IntStuff, Collections, PairCollections, IntStuff, IntFunctions;

Wi: PROC [i: INT] RETURNS [Value]
~ INLINE {RETURN [NEW [INT _ i]]};

Wp: PROC [pair: IVPair, dir: Direction] RETURNS [Pair]
~ INLINE {RETURN [IF dir=leftToRight THEN [NEW [INT _ pair.left], pair.right] ELSE [pair.right, NEW [INT _ pair.left]]]};

Ni: PROC [i: Value] RETURNS [INT]
~ INLINE {RETURN [NARROW[i, REF INT]^]};

Np: PROC [pair: Pair, dir: Direction] RETURNS [IVPair]
~ INLINE {RETURN [IF dir=leftToRight THEN [Ni[pair[left]], pair[right]] ELSE [Ni[pair[right]], pair[left]]]};

Nmi: PROC [mv: MaybeValue] RETURNS [MaybeInt]
~ INLINE {RETURN [IF mv.found THEN [TRUE, Ni[mv.val]] ELSE noInt]};

Nmp: PROC [mp: PCs.MaybePair, dir: Direction] RETURNS [MaybePair]
~ INLINE {RETURN [IF mp.found THEN [TRUE, Np[mp.pair, dir]] ELSE noMaybePair]};

QuaClasses: TYPE ~ ARRAY --isOneToOne--BOOL OF ARRAY --isDense--BOOL OF ARRAY --ordered--BOOL OF ARRAY Mutability OF IntFnClass;
quaClasses: REF QuaClasses ~ NEW [QuaClasses];

DefaultQuaIntFn: PUBLIC PROC [pc: PairColl, dir: Direction] RETURNS [MaybeValue] ~ {
from: Side ~ Source[dir];
IF pc.MayDuplicate OR NOT pc.Functional[][dir] THEN RETURN [noMaybe];
IF pc.Spaces[][from]#refInts THEN RETURN [noMaybe];
{q: Qua ~ NEW [QuaPrivate _ [pc, dir, OtherDirection[dir], Source[dir], Dest[dir]]];
isOneToOne: BOOL ~ pc.Functional[][q.inv];
ordered: BOOL ~ pc.OrderStyleOf=value AND dir=leftToRight AND IsDefaultOrdering[pc.OrderingOf];
isDense: BOOL _ ordered AND pc.Can[$Size] AND pc.MutabilityOf=constant;
IF isDense THEN {
size: LNAT ~ pc.Size[];
first: MaybeInt ~ Nmp[pc.First, q.dir].DropVal;
last: MaybeInt ~ Nmp[pc.Last, q.dir].DropVal;
IF size#0 AND Length[[min: first.I, max: last.I]] # IE[size] THEN isDense _ FALSE;
};
RETURN [[TRUE, Refify[[quaClasses[isOneToOne][isDense][ordered][pc.MutabilityOf], q]]]]}};

Qua: TYPE ~ REF QuaPrivate;
QuaPrivate: TYPE ~ RECORD [
pc: PairColl,
dir, inv: Direction,
from, to: Side
];

QuaPrimitive: PROC [fn: IntFn, op: ATOM, args: ArgList _ NIL] RETURNS [PrimitiveAnswer] ~ {
q: Qua ~ NARROW[fn.data];
SELECT op FROM
$HasPair, $Extremum, $Get3, $AddColl, $RemColl => RETURN [IF q.pc.QualityOf[op, args] >= goodDefault THEN yes ELSE no];
$Scan => RETURN [
IF GetRestriction[args,1]<GetRestriction[args,2] THEN IF q.pc.QualityOf[$ScanHalfRestriction, LIST[FromSide[q.to], FromBool[GetBool[args, 3]]]]>=goodDefault THEN yes ELSE no ELSE
IF GetRestriction[args,1]>unrestricted THEN IF q.pc.QualityOf[$ScanHalfRestriction, LIST[FromSide[q.from], FromBool[GetBool[args, 3]]]]>=goodDefault THEN yes ELSE no ELSE
IF q.pc.QualityOf[$Scan, LIST[FromBool[GetBool[args, 3]]]]>=goodDefault THEN yes ELSE no];
$Copy, $Insulate, $ValueOf, $Freeze, $Thaw => RETURN [IF q.pc.Can[op, args] THEN yes ELSE no];
$Apply => RETURN [IF q.pc.QualityOf[$Apply, LIST[FromDir[q.dir]]]>=goodDefault THEN yes ELSE no];
$InvApply => RETURN [IF q.pc.QualityOf[$Apply, LIST[FromDir[q.inv]]]>=goodDefault THEN yes ELSE no];
$Size => RETURN [IF GetRestriction[args, 1]=unrestricted AND GetRestriction[args, 2]=unrestricted THEN yes ELSE no];
$RightDeleteColl => RETURN [IF q.pc.QualityOf[$DeleteColl, LIST[FromSide[q.to]]]>=goodDefault THEN yes ELSE no];
$ReplaceMe => RETURN [IF fn.Can[$GetBounds] AND q.pc.Can[$DeleteColl, LIST[FromSide[q.from]]] AND fn.Can[$Apply] AND q.pc.Can[$AddColl] THEN yes ELSE no];
$RightCollection => RETURN [IF q.pc.QualityOf[$CollectionOf, LIST[FromSide[q.to]]]>=goodDefault THEN yes ELSE no];
$RightSpace => RETURN [IF q.pc.QualityOf[$Spaces]>=goodDefault THEN yes ELSE no];
ENDCASE => RETURN [pass];
};

QuaWiden: PROC [fn: IntFn] RETURNS [Function--[left]: REF INT--] ~ {
q: Qua ~ NARROW[fn.data];
RETURN [IF q.dir=leftToRight THEN q.pc ELSE q.pc.Invert]};

QuaHasPair: PROC [fn: IntFn, pair: IVPair] RETURNS [BOOL] ~ {
q: Qua ~ NARROW[fn.data];
RETURN q.pc.HasPair[Wp[pair, q.dir]]};

QuaApply: PROC [fn: IntFn, i: INT] RETURNS [MaybeValue] ~ {
q: Qua ~ NARROW[fn.data];
RETURN q.pc.Apply[Wi[i], q.dir]};

QuaInvApply: PROC [fn: IntFn, v: Value] RETURNS [MaybeInt] ~ {
q: Qua ~ NARROW[fn.data];
RETURN Nmi[q.pc.Apply[v, q.inv]]};

QuaScan: PROC [fn: IntFn, Test: Tester, left: Interval, right: Collection, bkwd: BOOL] RETURNS [MaybePair] ~ {
q: Qua ~ NARROW[fn.data];
Pass: PROC [pair: Pair] RETURNS [pass: BOOL _ FALSE] ~ {
i: INT ~ Ni[pair[left]];
pass _ left.Contains[i] AND right.HasMember[pair[right]] AND Test[[left: i, right: pair[right]]];
RETURN};
leftSize: EINT ~ left.Length;
rightSize: EINT ~ IF right.QualityOf[$Size] >= goodDefault THEN IE[right.Size[]] ELSE maxIntervalLength;
RETURN Nmp[IF leftSize.Compare[rightSize]=greater THEN q.pc.ScanHalfRestriction[right, Pass, q.to, bkwd] ELSE IF left#[] THEN q.pc.ScanHalfRestriction[CollectInterval[left], Pass, q.from, bkwd] ELSE q.pc.Scan[Pass, bkwd], q.dir]};

QuaExtremum: PROC [fn: IntFn, bkwd, remove: BOOL] RETURNS [MaybePair] ~ {
q: Qua ~ NARROW[fn.data];
RETURN Nmp[q.pc.Extremum[bkwd, remove], q.dir]};

QuaGet3: PROC [fn: IntFn, pair: IVPair] RETURNS [prev, same, next: MaybePair] ~ {
q: Qua ~ NARROW[fn.data];
wPrev, wSame, wNext: PCs.MaybePair;
[wPrev, wSame, wNext] _ q.pc.Get3[Wp[pair, q.dir]];
prev _ Nmp[wPrev, q.dir];
same _ Nmp[wSame, q.dir];
next _ Nmp[wNext, q.dir];
RETURN};

QuaSize: PROC [fn: IntFn, left: Interval, right: Collection, limit: LNAT] RETURNS [LNAT] ~ {
q: Qua ~ NARROW[fn.data];
est: Interval ~ IF fn.QualityOf[$GetBounds] >= goodDefault THEN fn.GetBounds ELSE [];
IF left.min<=est.min AND left.max>=est.max AND right=passAll THEN RETURN q.pc.Size[limit];
RETURN DefaultSize[fn, left, right, limit]};

QuaCopy: PROC [fn: IntFn] RETURNS [VarIntFn] ~ {
q: Qua ~ NARROW[fn.data];
RETURN DeRef[q.pc.Copy.AsIntFn].AsVar};

QuaInsulate: PROC [fn: IntFn] RETURNS [UWIntFn] ~ {
q: Qua ~ NARROW[fn.data];
RETURN DeRef[q.pc.Insulate.AsIntFn].AsUW};

QuaValueOf: PROC [fn: IntFn] RETURNS [ConstIntFn] ~ {
q: Qua ~ NARROW[fn.data];
RETURN DeRef[q.pc.ValueOf.AsIntFn].AsConst};

QuaFreeze: PROC [fn: IntFn] RETURNS [const: ConstIntFn] ~ {
q: Qua ~ NARROW[fn.data];
RETURN DeRef[q.pc.Freeze.AsIntFn].AsConst};

QuaThaw: PROC [fn: IntFn] ~ {
q: Qua ~ NARROW[fn.data];
q.pc.Thaw[];
RETURN};

QuaAddColl: PROC [fn, other: IntFn, if: IfNewsPair] RETURNS [some: NewsSetPair] ~ {
q: Qua ~ NARROW[fn.data];
RETURN q.pc.AddColl[other.Widen, if]};

QuaRemColl: PROC [fn, other: IntFn] RETURNS [hadSome, hadAll: BoolPair] ~ {
q: Qua ~ NARROW[fn.data];
RETURN q.pc.RemColl[other.Widen]};

QuaRightDeleteColl: PROC [fn: IntFn, coll: Collection, style: RemoveStyle] RETURNS [hadSome, hadAll: BOOL] ~ {
q: Qua ~ NARROW[fn.data];
RETURN q.pc.DeleteColl[coll, q.to, style]};

QuaReplaceMe: PROC [fn, with: IntFn, where, clip: Interval] RETURNS [losses, gains: EINT] ~ TRUSTED {
q: Qua ~ NARROW[fn.data];
oldBounds: Interval ~ fn.GetBounds;
whereLen: EINT ~ where.Length;
clipLen: EINT ~ clip.Length;
tailShift: EINT ~ clipLen.Sub[whereLen];
insertShift: EINT ~ ISub[where.min, clip.min];
beforeTail: INT ~ IF where.max>=where.min THEN where.max ELSE where.min-1;
oldTail: Interval ~ oldBounds.ClipBot[beforeTail];
newTail: Interval ~ oldTail.ShiftInterval[tailShift];
losses _ fn.GetBounds[].Intersect[where].Length;
[] _ q.pc.DeleteColl[CollectInterval[where], q.from, all];
MovePairs[fn, oldTail, newTail];
IF with=empty THEN gains _ zero ELSE {
add: IntFn ~ with.Reshape[[insertShift], clip];
[] _ q.pc.AddColl[add.Widen];
gains _ IE[add.Size];
};
RETURN};

MovePairs: PROC [fn: IntFn, from, to: Interval] ~ {
IF from=to THEN RETURN;
IF from.Length # to.Length THEN ERROR;
IF from.Empty THEN RETURN;
IF from.min > to.min THEN {
i: INT _ from.min;
j: INT _ to.min;
DO
mv: MaybeValue ~ fn.Apply[i];
IF mv.found THEN [] _ fn.AddPair[[j, mv.val]] ELSE [] _ fn.LeftDelete[j];
IF i = from.max THEN EXIT;
i _ i+1; j _ j+1;
ENDLOOP;
}
ELSE {
i: INT _ from.max;
j: INT _ to.max;
DO
mv: MaybeValue ~ fn.Apply[i];
IF mv.found THEN [] _ fn.AddPair[[j, mv.val]] ELSE [] _ fn.LeftDelete[j];
IF i = from.min THEN EXIT;
i _ i-1; j _ j-1;
ENDLOOP;
};
};

QuaRightCollection: PROC [fn: IntFn] RETURNS [UWColl] ~ {
q: Qua ~ NARROW[fn.data];
RETURN q.pc.CollectionOn[q.to]};

QuaRightSpace: PROC [fn: IntFn] RETURNS [Space] ~ {
q: Qua ~ NARROW[fn.data];
RETURN [q.pc.Spaces[][q.to]]};

Start: PROC ~ {
FOR isOneToOne: BOOL IN BOOL DO FOR isDense: BOOL IN BOOL DO FOR ordered: BOOL IN BOOL DO
quaClasses[isOneToOne][isDense][ordered][variable] _ CreateClass[[
Primitive: QuaPrimitive,
Widen: QuaWiden,
HasPair: QuaHasPair,
Apply: QuaApply,
InvApply: QuaInvApply,
Scan: QuaScan,
Extremum: QuaExtremum,
Get3: QuaGet3,
Size: QuaSize,
Copy: QuaCopy,
Insulate: QuaInsulate,
ValueOf: QuaValueOf,
Freeze: QuaFreeze,
Thaw: QuaThaw,
AddColl: QuaAddColl,
RemColl: QuaRemColl,
RightDeleteColl: QuaRightDeleteColl,
ReplaceMe: QuaReplaceMe,
RightCollection: QuaRightCollection,
RightSpace: QuaRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: variable,
domainFixed: FALSE]];
quaClasses[isOneToOne][isDense][ordered][readonly] _ CreateClass[[
Primitive: QuaPrimitive,
Widen: QuaWiden,
HasPair: QuaHasPair,
Apply: QuaApply,
InvApply: QuaInvApply,
Scan: QuaScan,
Extremum: QuaExtremum,
Get3: QuaGet3,
Size: QuaSize,
Copy: QuaCopy,
ValueOf: QuaValueOf,
RightCollection: QuaRightCollection,
RightSpace: QuaRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: readonly,
domainFixed: FALSE]];
quaClasses[isOneToOne][isDense][ordered][constant] _ CreateClass[[
Primitive: QuaPrimitive,
Widen: QuaWiden,
HasPair: QuaHasPair,
Apply: QuaApply,
InvApply: QuaInvApply,
Scan: QuaScan,
Extremum: QuaExtremum,
Get3: QuaGet3,
Size: QuaSize,
Copy: QuaCopy,
RightCollection: QuaRightCollection,
RightSpace: QuaRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: constant,
domainFixed: FALSE]];
ENDLOOP ENDLOOP ENDLOOP;
};

Start[];

END.
`StdIntFunctions2.Mesa
Last tweaked by Mike Spreitzer on October 16, 1987 10:20:44 am PDT
ΚΕ˜
code™Kš
œB™B—K˜KšΟk	œ>˜GK˜šΟnœœ
˜Kšœ5˜<Kšœ˜K˜
—K˜Kš
œ
œ
žœžœžœ@˜wK˜šžœœœœ˜!Kš	œœœœœ˜"—K˜šžœœ œ˜6Kšœœœœœœœœœœ˜y—K˜šžœœœœ
˜!Kšœœœœœ
œ˜(—K˜šžœœœ	˜6Kšœœœœœœ!˜m—K˜šžœœœ˜-Kš
œœœœ
œœœ	˜C—K˜šžœœ%œ˜AKš
œœœœ
œœœ˜O—K˜Kšœœœ
Οcœ
œ
œ
Ÿœ
œ
œ
Ÿœ
œ
œœ˜€
Kšœœœ˜.K˜šžœœ
œ œ˜TK˜Kš
œœ
œœ
œ˜EKšœœ
œ˜3Kšœ
œG˜TKšœœ˜*Kšœ	œœœ"˜_Kšœ	œœœ˜Gšœ	œ˜Kšœœ
˜K˜/K˜-Kš
œœ'œœœ
˜RK˜—KšœœM˜Z—K˜Kšœœœ˜šœœœ˜K˜
Kš
œ˜K˜K˜—K˜š
žœœœœœ˜[Kšœ	œ
˜šœ˜Kš	œ2œœ)œœ˜wšœ	œ˜Kš
œ/œ
œ&œ;œœ˜²
Kš
œ%œ
œ&œ=œœ˜ͺ
Kšœœ+œœ˜Z—Kš	œ.œœœœ˜^Kšœ
œœœœœ˜aKšœ
œœœœœ˜dKšœ	œœ&œ&œœ˜tKšœœœœœœ˜pKšœœœœœœœœœ˜š
Kšœœœœœœ˜rKš	œœœ&œœ˜QJšœœ˜—J˜—J˜šžœœ
œ
Ÿœ˜DKšœ	œ
˜Kšœœœœ˜:—K˜šž
œœœœ˜=Kšœ	œ
˜Kšœ ˜&—K˜šžœœœœ˜;Kšœ	œ
˜Kšœ˜!—K˜šžœœœ˜>Kšœ	œ
˜Kšœ˜"—K˜š
žœœ
žœ3œœ˜nKšœ	œ
˜š
žœœœœœ˜8Kšœœ˜Kšœœœ%˜aKšœ˜—Kšœ
œ˜Kšœœœ'œ
œœ˜hKšœœ%œ3œ
œ	œEœ ˜ζ
—K˜šžœœœœ˜IKšœ	œ
˜Kšœ*˜0—K˜šžœœœ"˜QKšœ	œ
˜K˜#K˜3K˜Kš
œ˜Kš
œ˜Kšœ˜—K˜š
žœœ7œœœ˜\Kšœ	œ
˜Kšœœ)œœ˜UKš
œœœœ
œ˜ZKšœ&˜,—K˜šžœœ
œ˜0Kšœ	œ
˜Kšœ!˜'—K˜šžœœ
œ˜3Kšœ	œ
˜Kšœ$˜*—K˜šž
œœ
œ˜5Kšœ	œ
˜Kšœ&˜,—K˜šž	œœ
œ˜;Kšœ	œ
˜Kšœ%˜+—K˜šžœœ˜Kšœ	œ
˜K˜Kšœ˜—K˜šž
œœ$œ˜SKšœ	œ
˜Kšœ ˜&—K˜šž
œœœ ˜KKšœ	œ
˜Kšœ˜"—K˜šžœœ3œœ˜nKšœ	œ
˜Kšœ%˜+—K˜š
žœœ*œœœ˜eKšœ	œ
˜K˜#Kšœ
œ˜Kšœ	œ˜Kšœœ˜(Kšœ
œ˜.Kš	œœœœœ
˜JKš
œ2˜2Kš
œ5˜5Kš
œ0˜0K˜:Kš
œ ˜ šœœœ˜&Kš
œ/˜/Kš
œ˜Kšœœ˜K˜—Kšœ˜—K˜šž	œœ$˜3Kšœ	œ
œ
˜Kšœœ
œ
˜&Kšœœ
œ
˜šœœ˜Kšœœ˜Kšœœ
˜š
˜K˜Kšœ
œœ˜IKšœœ
œ
˜K˜Kšœ
˜—K˜
—šœ˜Kšœœ˜Kšœœ
˜š
˜K˜Kšœ
œœ˜IKšœœ
œ
˜K˜Kšœ
˜—K˜—Kš
œ˜—K˜šžœœ
œ
˜9Kšœ	œ
˜Kšœ˜ —K˜šž
œœ
œ˜3Kšœ	œ
˜Kšœ˜—K˜šžœœ˜šœ
œ
œ
œ
œ
œ
œ
œ
œ
œ
œ
œ
œ
œ
˜Yš
œB˜BKšž	œ˜Kšžœ˜Kšžœ
˜Kšžœ˜Kšžœ˜Kšžœ
˜Kšžœ˜Kšžœ
˜Kšžœ
˜Kšžœ
˜Kšžœ˜Kšžœ
˜Kšžœ˜Kšžœ
˜Kšžœ
˜Kšžœ
˜Kšžœ˜$Kšž	œ˜Kšžœ˜$Kšž
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜Kšœ
œ˜—š
œB˜BKšž	œ˜Kšžœ˜Kšžœ
˜Kšžœ˜Kšžœ˜Kšžœ
˜Kšžœ˜Kšžœ
˜Kšžœ
˜Kšžœ
˜Kšžœ
˜Kšžœ˜$Kšž
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜Kšœ
œ˜—š
œB˜BKšž	œ˜Kšžœ˜Kšžœ
˜Kšžœ˜Kšžœ˜Kšžœ
˜Kšžœ˜Kšžœ
˜Kšžœ
˜Kšžœ
˜Kšžœ˜$Kšž
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜Kšœ
œ˜—Kšœ
œ
œ
˜—K˜—K˜K˜K˜Kšœ
˜—…—'T4y