StdIntFunctions2.Mesa
Last tweaked by Mike Spreitzer on October 16, 1987 10:20:44 am PDT
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.