StdIntFunctions1.Mesa
Last tweaked by Mike Spreitzer on October 16, 1987 10:22:09 am PDT
DIRECTORY Basics, Collections, IntFunctions, IntStuff, PairCollections, List;
StdIntFunctions1:
CEDAR
PROGRAM
IMPORTS Collections, IntFunctions, IntStuff, PairCollections, List
EXPORTS IntFunctions
=
BEGIN OPEN PCs:PairCollections, Colls:Collections, Ints:IntStuff, Collections, PairCollections, IntStuff, IntFunctions;
emptyClass: IntFnClass ~ CreateClass[[
HasPair: EmptyHasPair,
Apply: EmptyApply,
InvApply: EmptyInvApply,
Scan: EmptyScan,
Extremum: EmptyExtremum,
Get3: EmptyGet3,
Index: EmptyIndex,
Size: EmptySize,
GetBounds: EmptyGetBounds,
RightCollection: EmptyRightCollection,
CurRange: EmptyCurRange,
isOneToOne: TRUE,
isDense: TRUE,
ordered: TRUE,
mutability: constant,
domainFixed: TRUE],
ALL[TRUE]];
empty: PUBLIC ConstIntFn ~ AsConst[[emptyClass, NIL]];
EmptyHasPair:
PROC [fn: IntFn, pair: IVPair]
RETURNS [
BOOL]
~ {RETURN [FALSE]};
EmptyApply:
PROC [fn: IntFn, i:
INT]
RETURNS [MaybeValue]
~ {RETURN [noMaybe]};
EmptyInvApply:
PROC [fn: IntFn, v: Value]
RETURNS [MaybeInt]
~ {RETURN [noInt]};
EmptyScan:
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [MaybePair]
~ {RETURN [noMaybePair]};
EmptyExtremum:
PROC [fn: IntFn, bkwd, remove:
BOOL]
RETURNS [MaybePair]
~ {RETURN [noMaybePair]};
EmptyGet3:
PROC [fn: IntFn, pair: IVPair]
RETURNS [prev, same, next: MaybePair]
~ {RETURN [noMaybePair, noMaybePair, noMaybePair]};
EmptyIndex:
PROC [fn, goal: IntFn, bounds: Interval, bkwd:
BOOL]
RETURNS [MaybeInt]
~ {RETURN [noInt]};
EmptySize:
PROC [fn: IntFn, left: Interval, right: Collection, limit:
LNAT]
RETURNS [
LNAT]
~ {RETURN [0]};
EmptyGetBounds:
PROC [fn: IntFn]
RETURNS [Interval]
~ {RETURN [anEmptyInterval]};
EmptyRightCollection:
PROC [fn: IntFn]
RETURNS [UWColl]
~ {RETURN [emptySet]};
EmptyCurRange:
PROC [fn: IntFn]
RETURNS [ConstSet]
~ {RETURN [emptySet]};
Singleton: TYPE ~ REF SingletonPrivate;
SingletonPrivate:
TYPE ~
RECORD [
pair: IVPair,
right: Space
];
CreateSingleton:
PUBLIC
PROC [pair: IVPair, right: Space]
RETURNS [ConstIntFn] ~ {
s: Singleton ~ NEW [SingletonPrivate ← [pair, right]];
RETURN AsConst[[singletonClass, s]]};
singletonClass: IntFnClass ~ CreateClass[[
HasPair: SingletonHasPair,
Apply: SingletonApply,
InvApply: SingletonInvApply,
Scan: SingletonScan,
Extremum: SingletonExtremum,
Get3: SingletonGet3,
Size: SingletonSize,
GetBounds: SingletonGetBounds,
CurRange: SingletonCurRange,
RightSpace: SingletonRightSpace,
isOneToOne: TRUE,
isDense: TRUE,
ordered: TRUE,
mutability: constant,
domainFixed: TRUE],
ALL[TRUE]];
SingletonHasPair:
PROC [fn: IntFn, pair: IVPair]
RETURNS [
BOOL] ~ {
s: Singleton ~ NARROW[fn.data];
RETURN [s.pair.left=pair.left AND s.right.SpaceEqual[s.pair.right, pair.right]]};
SingletonApply:
PROC [fn: IntFn, i:
INT]
RETURNS [MaybeValue] ~ {
s: Singleton ~ NARROW[fn.data];
RETURN [IF s.pair.left=i THEN [TRUE, s.pair.right] ELSE noMaybe]};
SingletonInvApply:
PROC [fn: IntFn, v: Value]
RETURNS [MaybeInt] ~ {
s: Singleton ~ NARROW[fn.data];
RETURN [IF s.right.SpaceEqual[s.pair.right, v] THEN [TRUE, s.pair.left] ELSE noInt]};
SingletonScan:
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [MaybePair] ~ {
s: Singleton ~ NARROW[fn.data];
RETURN [IF Test[s.pair] THEN [TRUE, s.pair] ELSE noMaybePair]};
SingletonExtremum:
PROC [fn: IntFn, bkwd, remove:
BOOL]
RETURNS [MaybePair] ~ {
s: Singleton ~ NARROW[fn.data];
IF remove THEN fn.Complain[notVariable];
RETURN [[TRUE, s.pair]]};
SingletonGet3:
PROC [fn: IntFn, pair: IVPair]
RETURNS [prev, same, next: MaybePair] ~ {
s: Singleton ~ NARROW[fn.data];
prev ← same ← next ← noMaybePair;
SELECT
TRUE
FROM
pair.left=s.pair.left => same ← [TRUE, s.pair];
Succeeds[pair.left, s.pair.left] => prev ← [TRUE, s.pair];
Preceeds[pair.left, s.pair.left] => next ← [TRUE, s.pair];
ENDCASE => NULL;
RETURN};
SingletonSize: PROC [fn: IntFn, left: Interval, right: Collection, limit: LNAT] RETURNS [LNAT] ~ {RETURN [1]};
SingletonGetBounds:
PROC [fn: IntFn]
RETURNS [Interval] ~ {
s: Singleton ~ NARROW[fn.data];
RETURN [[s.pair.left, s.pair.left]]};
SingletonCurRange:
PROC [fn: IntFn]
RETURNS [ConstSet] ~ {
s: Singleton ~ NARROW[fn.data];
RETURN Colls.CreateSingleton[s.pair.right, s.right]};
SingletonRightSpace:
PROC [fn: IntFn]
RETURNS [Space] ~ {
s: Singleton ~ NARROW[fn.data];
RETURN [s.right]};
Lyst: TYPE ~ REF LystPrivate;
LystPrivate:
TYPE ~
RECORD [
right: Space,
elts: LOP,
size: LNAT ← 0,
bounds: Interval ← [INT.LAST, INT.FIRST]
];
CreateFromList:
PUBLIC
PROC [vals:
LOP, oneToOne:
BOOL ←
FALSE, right: Space ← refs, invable:
BOOL ←
FALSE]
RETURNS [ConstIntFn] ~ {
lcs: REF LystClasses ← NARROW[List.Assoc[key: lystClassesKey, aList: right.other]];
l: Lyst ~ NEW [LystPrivate ← [right, vals]];
first, ordered: BOOL ← TRUE;
prev: INT;
IF lcs=
NIL
THEN {
lcs ← NEW [LystClasses];
FOR isOneToOne:
BOOL
IN
BOOL
DO
FOR isDense:
BOOL
IN
BOOL
DO
FOR ordered:
BOOL
IN
BOOL
DO
lcs[isOneToOne][isDense][ordered] ← CreateClass[[
HasPair: LystHasPair,
Apply: LystApply,
InvApply: LystInvApply,
Scan: LystScan,
Size: LystSize,
GetBounds: LystGetBounds,
RightSpace: LystRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: constant,
domainFixed: TRUE]];
ENDLOOP ENDLOOP ENDLOOP;
right.other ← List.PutAssoc[lystClassesKey, lcs, right.other];
};
FOR vals ← vals, vals.rest
WHILE vals#
NIL
DO
l.size ← l.size+1;
l.bounds.min ← MIN[l.bounds.min, vals.first.left];
l.bounds.max ← MAX[l.bounds.max, vals.first.left];
IF first THEN first ← FALSE ELSE IF vals.first.left#prev.SUCC THEN ordered ← FALSE;
prev ← vals.first.left;
ENDLOOP;
{fn: IntFn ← [lcs[oneToOne][l.bounds.Length=IE[l.size]][ordered], l];
IF invable THEN fn ← fn.CreatePartnership[DeRef[CreateHashReln[[refInts, right], [TRUE, oneToOne], [FALSE, TRUE]].AsIntFn]];
RETURN fn.AsConst[];
}};
LystClasses: TYPE ~ ARRAY --isOneToOne--BOOL OF ARRAY --isDense--BOOL OF ARRAY --ordered--BOOL OF IntFnClass;
lystClassesKey: ATOM ~ $StdIntFunctionsImplLystClasses;
LystHasPair:
PROC [fn: IntFn, pair: IVPair]
RETURNS [
BOOL] ~ {
l: Lyst ~ NARROW[fn.data];
right: Space ~ l.right;
FOR elts:
LOP ← l.elts, elts.rest
WHILE elts#
NIL
DO
IF elts.first.left=pair.left AND right.SpaceEqual[pair.right, elts.first.right] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE]};
LystApply:
PROC [fn: IntFn, i:
INT]
RETURNS [MaybeValue] ~ {
l: Lyst ~ NARROW[fn.data];
FOR elts:
LOP ← l.elts, elts.rest
WHILE elts#
NIL
DO
IF elts.first.left=i THEN RETURN [[TRUE, elts.first.right]];
ENDLOOP;
RETURN [noMaybe]};
LystInvApply:
PROC [fn: IntFn, v: Value]
RETURNS [MaybeInt] ~ {
l: Lyst ~ NARROW[fn.data];
right: Space ~ l.right;
FOR elts:
LOP ← l.elts, elts.rest
WHILE elts#
NIL
DO
IF right.SpaceEqual[v, elts.first.right] THEN RETURN [[TRUE, elts.first.left]];
ENDLOOP;
RETURN [noInt]};
LystScan:
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [MaybePair] ~ {
l: Lyst ~ NARROW[fn.data];
IF bkwd THEN RETURN DefaultScan[fn, Test, left, right, bkwd];
FOR elts:
LOP ← l.elts, elts.rest
WHILE elts#
NIL
DO
IF left.Contains[elts.first.left] AND right.HasMember[elts.first.right] AND Test[elts.first] THEN RETURN [[TRUE, elts.first]];
ENDLOOP;
RETURN [noMaybePair]};
LystSize:
PROC [fn: IntFn, left: Interval, right: Collection, limit:
LNAT]
RETURNS [
LNAT] ~ {
l: Lyst ~ NARROW[fn.data];
RETURN [l.size]};
LystGetBounds:
PROC [fn: IntFn]
RETURNS [Interval] ~ {
l: Lyst ~ NARROW[fn.data];
RETURN [l.bounds]};
LystRightSpace:
PROC [fn: IntFn]
RETURNS [Space] ~ {
l: Lyst ~ NARROW[fn.data];
RETURN [l.right]};
Simple: TYPE ~ REF SimplePrivate;
SimplePrivate:
TYPE ~
RECORD [
right: Space,
bounds: Interval,
d: INT,
vals: SimpleElts,
freezeCount: INT ← 0];
elt i is stored in vals[i-d]. Thus, there is storage for elts [d .. d+vals.size). Storage cells not corresponding to domain elts have noValue in them.
SimpleElts: TYPE ~ REF SimpleEltsPrivate;
SimpleEltsPrivate:
TYPE ~
RECORD [
vals: SEQUENCE size: NATURAL OF Value
];
SimpleClasses: TYPE ~ ARRAY --isOneToOne--BOOL OF ARRAY --dense--BOOL OF ARRAY --domainFixed--BOOL OF ARRAY Mutability OF IntFnClass;
simpleClasses: REF SimpleClasses ~ NEW [SimpleClasses];
CreateSimple:
PUBLIC
PROC [bounds: Interval ← [0, -1], val: Value ← noValue, oneToOne, dense, domainFixed, invable:
BOOL ←
FALSE, rightSpace: Space ← refs]
RETURNS [Array] ~ {
vals: SimpleElts ~ NEW [SimpleEltsPrivate[bounds.Length.EN]];
simple: Simple ~ NEW [SimplePrivate ← [rightSpace, bounds, bounds.min, vals]];
FOR i: NATURAL IN [0 .. vals.size) DO vals[i] ← val ENDLOOP;
IF val=noValue THEN simple.bounds ← simple.bounds.ClipTop[simple.bounds.min];
{fn: IntFn ← [simpleClasses[oneToOne][dense][domainFixed][variable], simple];
IF invable
THEN {
otherHalf: IntFn ~ DeRef[CreateHashReln[[refInts, rightSpace], [TRUE, oneToOne], [FALSE, TRUE]].AsIntFn];
[] ← otherHalf.AddColl[fn];
fn ← fn.CreatePartnership[otherHalf];
};
RETURN [fn]}};
CreateSimpleCopy:
PUBLIC
PROC [array: Array, bounds: Interval ← [], oneToOne, dense, domainFixed: NewBOOL ←
SAME, invable:
BOOL ←
FALSE, rightSpace: Space ←
NIL]
RETURNS [Array] ~ {
realBounds: Interval ~ array.GetBounds.Intersect[bounds];
realSpace: Space ~ IF rightSpace#NIL THEN rightSpace ELSE array.RightSpace;
vals: SimpleElts ~ NEW [SimpleEltsPrivate[realBounds.Length.EN]];
simple: Simple ~ NEW [SimplePrivate ← [realSpace, realBounds, realBounds.min, vals]];
newOneToOne: BOOL ~ oneToOne.UpdateBool[array.IsOneToOne];
FOR i: INT IN [realBounds.min .. realBounds.max] DO vals[i-simple.d] ← array.Apply[i].Val ENDLOOP;
{fn: IntFn ← [
simpleClasses
[newOneToOne]
[dense.UpdateBool[array.DomainIsDense]]
[domainFixed.UpdateBool[array.DomainIsFixed]]
[variable],
simple];
IF invable THEN fn ← fn.CreatePartnership[DeRef[CreateHashReln[[refInts, realSpace], [TRUE, newOneToOne], [FALSE, TRUE]].AsIntFn]];
RETURN [fn]}};
SimpleApply:
PROC [fn: IntFn, i:
INT]
RETURNS [mv: MaybeValue] ~ {
simple: Simple ~ NARROW[fn.data];
IF fn.MutabilityOf=constant AND simple.freezeCount=0 THEN Complain[fn, unfrozen];
IF NOT simple.bounds.Contains[i] THEN RETURN [noMaybe];
mv.val ← simple.vals[i-simple.d];
mv.found ← mv.val # noValue;
RETURN};
SimpleScan:
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [MaybePair] ~ {
simple: Simple ~ NARROW[fn.data];
vals: SimpleElts ~ simple.vals;
scanBounds: Interval ~ simple.bounds.Intersect[left];
IF fn.MutabilityOf=constant AND simple.freezeCount=0 THEN Complain[fn, unfrozen];
IF bkwd
THEN
FOR i:
INT
DECREASING
IN [scanBounds.min .. scanBounds.max]
DO
pair: IVPair ~ [i, simple.vals[i-simple.d]];
IF pair.right#noValue AND right.HasMember[pair.right] AND Test[pair] THEN RETURN [[TRUE, pair]];
ENDLOOP
ELSE
FOR i:
INT
IN [scanBounds.min .. scanBounds.max]
DO
pair: IVPair ~ [i, simple.vals[i-simple.d]];
IF pair.right#noValue AND right.HasMember[pair.right] AND Test[pair] THEN RETURN [[TRUE, pair]];
ENDLOOP;
RETURN [noMaybePair]};
SimpleGetBounds:
PROC [fn: IntFn]
RETURNS [Interval] ~ {
simple: Simple ~ NARROW[fn.data];
IF fn.MutabilityOf=constant AND simple.freezeCount=0 AND NOT fn.DomainIsFixed THEN Complain[fn, unfrozen];
RETURN [simple.bounds]};
SimpleCopy:
PROC [fn: IntFn]
RETURNS [VarIntFn] ~ {
simple: Simple ~ NARROW[fn.data];
IF fn.MutabilityOf=constant AND simple.freezeCount=0 THEN Complain[fn, unfrozen];
RETURN CreateSimpleCopy[fn].AsVar};
SimpleFreeze:
PROC [fn: IntFn]
RETURNS [ConstIntFn] ~ {
simple: Simple ~ NARROW[fn.data];
IF fn.MutabilityOf#variable THEN Complain[fn, notVariable];
simple.freezeCount ← simple.freezeCount + 1;
RETURN AsConst[[
simpleClasses[fn.IsOneToOne][fn.DomainIsDense][fn.DomainIsFixed][constant],
simple]];
};
SimpleThaw:
PROC [fn: IntFn] ~ {
simple: Simple ~ NARROW[fn.data];
IF fn.MutabilityOf#variable THEN Complain[fn, notVariable];
IF simple.freezeCount<=0 THEN Complain[fn, "too many thaws"];
simple.freezeCount ← simple.freezeCount-1;
RETURN};
SimpleAddColl:
PROC [fn, other: IntFn, if: IfNewsPair]
RETURNS [some: NewsSetPair] ~ {
simple: Simple ~ NARROW[fn.data];
right: Space ~ simple.right;
bounds: Interval;
d: INT;
vals: SimpleElts;
newCount: NATURAL ← 0;
expansionCount: NATURAL ← 0;
Per:
PROC [pair: IVPair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
news: News ← different;
IF bounds.Contains[pair.left]
THEN {
old: Value ~ vals[pair.left-d];
IF old=noValue
THEN {
news ← new;
newCount ← newCount+1;
}
ELSE IF right.SpaceEqual[pair.right, old] THEN news ← same
}
ELSE IF fn.DomainIsFixed THEN fn.Complain[fixedDomain]
ELSE {
de: NATURAL ~ EnsureContains[simple, [pair.left, pair.left]];
IF de=0 THEN ERROR;
expansionCount ← expansionCount + de;
newCount ← newCount+1;
bounds ← simple.bounds;
d ← simple.d;
vals ← simple.vals;
news ← new;
};
vals[pair.left-d] ← pair.right;
some[leftToRight][news] ← TRUE;
RETURN};
IF fn.MutabilityOf # variable THEN fn.Complain[notVariable];
IF simple.freezeCount#0 THEN fn.Complain[frozen];
some ← ALL[ALL[FALSE]];
IF other.QualityOf[$GetBounds] >= goodDefault THEN expansionCount ← EnsureContains[simple, other.GetBounds[]];
bounds ← simple.bounds;
d ← simple.d;
vals ← simple.vals;
[] ← other.Scan[Per];
IF newCount>expansionCount THEN ERROR;
IF fn.DomainIsDense AND newCount<expansionCount THEN fn.Complain["AddColl didn't keep domain dense"];
IF newCount#0 THEN some[leftToRight][new] ← TRUE;
RETURN};
EnsureContains:
PROC [simple: Simple, bounds: Interval]
RETURNS [expansionCount:
NATURAL] ~ {
IF bounds.min >= simple.bounds.min AND bounds.max <= simple.bounds.max THEN RETURN [0];
{oldVals: SimpleElts ~ simple.vals;
oldSize: NATURAL ~ oldVals.size;
oldBounds: Interval ~ simple.bounds;
newBounds: Interval ~ simple.bounds.MBI[bounds];
newLen: NATURAL ~ newBounds.Length.EN;
oldD: INT ~ simple.d;
expansionCount ← newLen - oldBounds.Length.EN;
simple.bounds ← newBounds;
IF newBounds.min >= oldD AND newBounds.max <= oldD+(oldSize-1) THEN RETURN;
IF newLen <= oldSize
THEN {
newPad: INT ~ (oldSize - newLen)/2;
newD: INT ~ ISub[newBounds.min, newPad].ClipI;
IF new
D > old
D
THEN {
FOR i:
INT
IN [oldBounds.min .. oldBounds.max]
DO
oldVals[i-newD] ← oldVals[i-oldD];
ENDLOOP;
IF
NOT oldBounds.Empty
THEN
FOR i:
INT
IN (oldBounds.max-new
D .. oldBounds.max-old
D]
DO
oldVals[i] ← noValue;
ENDLOOP;
};
IF new
D < old
D
THEN {
FOR i:
INT
DECREASING
IN [oldBounds.min .. oldBounds.max]
DO
oldVals[i-newD] ← oldVals[i-oldD];
ENDLOOP;
IF
NOT oldBounds.Empty
THEN
FOR i:
INT
IN [oldBounds.min-old
D .. oldBounds.min-new
D)
DO
oldVals[i] ← noValue;
ENDLOOP;
};
simple.d ← newD;
RETURN};
{newSize: NATURAL ~ MIN[INT[NATURAL.LAST], MAX[newLen, INT[oldSize]*2]];
newVals: SimpleElts ~ NEW [SimpleEltsPrivate[newSize]];
newPad: INT ~ (newSize - newLen)/2;
newD: INT ~ newBounds.min - newPad;
IF oldBounds.Empty
THEN {
FOR i: INT IN [0 .. newSize) DO newVals[i] ← noValue ENDLOOP;
}
ELSE {
FOR i: INT IN [0 .. oldBounds.min-newD) DO newVals[i] ← noValue ENDLOOP;
FOR i: INT IN [oldBounds.min .. oldBounds.max] DO newVals[i-newD] ← oldVals[i-oldD] ENDLOOP;
FOR i: INT IN (oldBounds.max-newD .. newSize) DO newVals[i] ← noValue ENDLOOP;
};
simple.d ← newD;
simple.vals ← newVals;
RETURN}}};
SimpleDenseRemColl:
PROC [fn, other: IntFn]
RETURNS [hadSome, hadAll: BoolPair] ~ {
simple: Simple ~ NARROW[fn.data];
vals: SimpleElts ~ simple.vals;
right: Space ~ simple.right;
oldBounds: Interval ~ simple.bounds;
otherBounds: Interval ~ other.GetBounds[];
scanBounds: Interval ~ oldBounds.Intersect[otherBounds];
mustKeep: Interval ← anEmptyInterval;
may: Interval ← oldBounds;
losses: NATURAL ← 0;
Per:
PROC [pair: IVPair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
i: INT ~ pair.left;
hadIt: BOOL ~ right.SpaceEqual[pair.right, vals[i-simple.d]];
IF hadIt
THEN {
IF fn.DomainIsFixed THEN fn.Complain[fixedDomain]
ELSE IF mustKeep.Contains[i] THEN fn.Complain["RemColl does not leave domain dense"]
ELSE
IF may.Contains[i]
THEN {
SELECT i
FROM
< mustKeep.min => may.min ← i+1;
> mustKeep.max => may.max ← i-1;
ENDCASE => ERROR;
};
vals[i-simple.d] ← noValue;
hadSome[leftToRight] ← TRUE;
losses ← losses + 1;
}
ELSE {
IF NOT may.Contains[i] THEN fn.Complain["RemColl does not leave domain dense"]
ELSE IF NOT mustKeep.Contains[i] THEN mustKeep ← [min: MIN[mustKeep.min, i], max: MAX[mustKeep.max, i]];
hadAll[leftToRight] ← FALSE;
};
};
IF fn.MutabilityOf # variable THEN fn.Complain[notVariable];
IF simple.freezeCount#0 THEN fn.Complain[frozen];
hadSome ← ALL[FALSE];
hadAll ← ALL[scanBounds=otherBounds];
[] ← other.Scan[Per, scanBounds];
simple.bounds ← may;
simple.d ← simple.d - oldBounds.min + simple.bounds.min;
IF may.Length.AddI[losses] # oldBounds.Length THEN fn.Complain["RemColl does not leave domain dense"];
RETURN};
SimpleSparseRemColl:
PROC [fn, other: IntFn]
RETURNS [hadSome, hadAll: BoolPair] ~ {
simple: Simple ~ NARROW[fn.data];
vals: SimpleElts ~ simple.vals;
right: Space ~ simple.right;
oldBounds: Interval ~ simple.bounds;
otherBounds: Interval ~ other.ImproveBounds[[]];
scanBounds: Interval ~ otherBounds.Intersect[oldBounds];
rebound: BOOL ← FALSE;
Per:
PROC [pair: IVPair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
i: INT ~ pair.left;
hadIt: BOOL ~ right.SpaceEqual[pair.right, vals[i-simple.d]];
IF hadIt
THEN {
IF fn.DomainIsFixed THEN fn.Complain[fixedDomain];
IF i=oldBounds.min OR i=oldBounds.max THEN rebound ← TRUE;
vals[i-simple.d] ← noValue;
hadSome[leftToRight] ← TRUE;
}
ELSE {
hadAll[leftToRight] ← FALSE;
};
};
IF fn.MutabilityOf # variable THEN fn.Complain[notVariable];
IF simple.freezeCount#0 THEN fn.Complain[frozen];
hadSome ← ALL[FALSE];
hadAll ← ALL[scanBounds=otherBounds];
[] ← other.Scan[Per, oldBounds];
IF rebound THEN FixBounds[fn, simple];
RETURN};
FixBounds:
PROC [fn: IntFn, simple: Simple] ~ {
vals: SimpleElts ~ simple.vals;
d: INT ~ simple.d;
oldBounds: Interval ~ simple.bounds;
newBounds: Interval ← oldBounds;
WHILE newBounds.min<=newBounds.max AND vals[newBounds.min-d]=noValue DO newBounds ← newBounds.ClipBot[newBounds.min] ENDLOOP;
WHILE newBounds.min<=newBounds.max AND vals[newBounds.max-d]=noValue DO newBounds ← newBounds.ClipTop[newBounds.max] ENDLOOP;
simple.bounds ← newBounds;
IF NOT (oldBounds.Empty OR newBounds.Empty) THEN simple.d ← simple.d - simple.bounds.min + newBounds.min;
RETURN};
LeftDelete:
PROC [simple: Simple, where: Interval] ~ {
IF where.Empty OR simple.bounds.Empty OR where.max < simple.bounds.min OR where.min > simple.bounds.max THEN RETURN;
FOR i: INT IN [MAX[where.min, simple.bounds.min] .. MIN[where.max, simple.bounds.max]] DO simple.vals[i-simple.d] ← noValue ENDLOOP;
IF where.min > simple.bounds.min
THEN
IF where.max < simple.bounds.max
THEN NULL
ELSE simple.bounds.max ← where.min-1
ELSE
IF where.max < simple.bounds.max
THEN simple.bounds.min ← where.max+1
ELSE simple.bounds ← anEmptyInterval;
RETURN};
SimpleReplaceMe:
PROC [fn, with: IntFn, where, clip: Interval]
RETURNS [losses, gains:
EINT] ~ {
simple: Simple ~ NARROW[fn.data];
clipLen: EINT ~ clip.Length;
whereLen: EINT ~ where.Length;
tailShift: EINT ~ clipLen.Sub[whereLen];
insertShift: EINT ~ ISub[where.min, clip.min];
oldBounds: Interval ~ simple.bounds;
insertBoundsEst: Interval ~ clip.ClipShiftInterval[insertShift];
beforeTail: INT ~ IF where.Empty THEN where.min-1 ELSE where.max;
newBoundsEst, headNeed, tailNeed: Interval;
bounds: Interval ← anEmptyInterval;
AddStuff:
PROC [new: Interval] ~ {
bounds ← bounds.MBI[new];
};
AddPair:
PROC [pair: IVPair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
i: INT ~ insertShift.AddI[pair.left].EI;
[] ← EnsureContains[simple, [i, i]];
AddStuff[[i, i]];
simple.vals[i-simple.d] ← pair.right;
TRUSTED {gains ← gains.Succ};
};
IF fn.MutabilityOf # variable THEN fn.Complain[notVariable];
IF simple.freezeCount#0 THEN fn.Complain[frozen];
SELECT
TRUE
FROM
oldBounds.max < where.min => {headNeed ← newBoundsEst ← oldBounds; tailNeed ← anEmptyInterval};
oldBounds.min > beforeTail => {tailNeed ← newBoundsEst ← oldBounds.ShiftInterval[tailShift]; headNeed ← anEmptyInterval};
ENDCASE => {
newBoundsEst ← [
min: MIN[oldBounds.min, where.min],
max: tailShift.AddI[MAX[oldBounds.max, where.max]].ClipI];
headNeed ← newBoundsEst.ClipTop[where.min];
tailNeed ← newBoundsEst.ClipBot[tailShift.AddI[beforeTail].ClipI]};
TRUSTED {losses ← oldBounds.Intersect[where].Length; gains ← zero};
[] ← EnsureContains[simple, tailNeed];
AddStuff[headNeed];
AddStuff[tailNeed];
IF
NOT tailNeed.Empty
THEN
SELECT tailShift.Sgn[]
FROM
<0 => {
FOR i:
INT
IN [tailNeed.min .. tailNeed.max]
DO
j: INT ~ IE[i].Sub[tailShift].EI;
simple.vals[i-simple.d] ← simple.vals[j-simple.d];
ENDLOOP;
{olds: Interval ~ oldBounds.ClipBot[MAX[tailNeed.max, where.max]];
FOR i:
INT
IN [olds.min .. olds.max]
DO
simple.vals[i-simple.d] ← noValue;
ENDLOOP;
}};
>0 => {
FOR i:
INT
DECREASING
IN [tailNeed.min .. tailNeed.max]
DO
j: INT ~ IE[i].Sub[tailShift].EI;
simple.vals[i-simple.d] ← simple.vals[j-simple.d];
ENDLOOP;
{olds: Interval ~ oldBounds.ClipBot[insertBoundsEst.max].ClipTop[tailNeed.min];
FOR i:
INT
IN [olds.min .. olds.max]
DO
simple.vals[i-simple.d] ← noValue;
ENDLOOP;
}};
=0 => NULL;
ENDCASE => ERROR;
LeftDelete[simple, insertBoundsEst];
[] ← with.Scan[AddPair, clip];
IF fn.DomainIsDense AND gains.Add[headNeed.Length].Add[tailNeed.Length] # bounds.Length THEN fn.Complain["ReplaceMe didn't keep domain dense"];
IF fn.DomainIsFixed AND bounds#oldBounds THEN fn.Complain[fixedDomain];
simple.bounds ← bounds;
IF NOT (bounds.Empty OR oldBounds.Empty) THEN simple.d ← simple.d-oldBounds.min+simple.bounds.min;
};
SimpleReshapeMe:
PROC [fn: IntFn, lt: XForm, lb: Interval, rt: OneToOne, rb: Collection] ~ {
simple: Simple ~ NARROW[fn.data];
IF fn.MutabilityOf#variable THEN fn.Complain[notVariable];
IF simple.freezeCount#0 THEN fn.Complain[frozen];
IF rb#passAll OR rt#PCs.id OR lt.d#1
THEN {
vals: SimpleElts ~ simple.vals;
d: INT ~ simple.d;
oldBounds: Interval ~ simple.bounds;
newBounds: Interval ~ lt.XFormInterval[oldBounds];
new: IntFn ~ CreateSimple[
bounds: newBounds,
val: fn.First.DP.right,
oneToOne: fn.IsOneToOne,
domainFixed: fn.DomainIsFixed,
dense: fn.DomainIsDense,
rightSpace: simple.right];
simple2: Simple ~ NARROW[new.data];
vals2: SimpleElts ~ simple2.vals;
d2: INT ~ simple2.d;
i: INT ← oldBounds.min;
j: INT ← lt.XFormInt[i];
IF fn.DomainIsFixed AND newBounds#simple.bounds THEN fn.Complain[fixedDomain];
IF lt.d=0 THEN fn.Complain["Given a degenerate XForm"];
IF fn.DomainIsDense AND lt.d#1 AND lt.d#-1 AND oldBounds.max>oldBounds.min THEN fn.Complain["ReshapeMe doesn't leave domain dense"];
FOR i ← i, i+1
WHILE i <= oldBounds.max
DO
vals2[j-d2] ← vals[i-d];
j ← j + lt.d;
ENDLOOP;
simple^ ← simple2^;
}
ELSE {
unshifted: Interval ~ simple.bounds.Intersect[lb];
newBounds: Interval ~ unshifted.ClipShiftInterval[lt.o];
IF fn.DomainIsFixed AND newBounds#simple.bounds THEN fn.Complain[fixedDomain];
FOR i: INT IN [simple.bounds.min .. unshifted.min) DO simple.vals[i-simple.d] ← noValue ENDLOOP;
FOR i: INT IN (unshifted.max .. simple.bounds.max] DO simple.vals[i-simple.d] ← noValue ENDLOOP;
simple.d ← lt.XFormInt[simple.d];
simple.bounds ← newBounds;
};
RETURN};
SimpleRightSpace:
PROC [fn: IntFn]
RETURNS [Space] ~ {
simple: Simple ~ NARROW[fn.data];
RETURN [simple.right]};
Succeeds:
PROC [a, b:
INT]
RETURNS [
BOOL]
~ INLINE {RETURN [b<INT.LAST AND a=b+1]};
Preceeds:
PROC [a, b:
INT]
RETURNS [
BOOL]
~ INLINE {RETURN [b>INT.FIRST AND a=b-1]};
ClipPred:
PROC [i:
INT]
RETURNS [
INT]
~ INLINE {RETURN [IF i > INT.FIRST THEN i-1 ELSE INT.FIRST]};
ClipSucc:
PROC [i:
INT]
RETURNS [
INT]
~ INLINE {RETURN [IF i < INT.LAST THEN i+1 ELSE INT.LAST]};
Equal:
PUBLIC
PROC [a, b: IntFn, bounds: Interval ← []]
RETURNS [
BOOL] ~ {
c: Basics.Comparison ~ Compare[a, b, bounds];
RETURN [c=equal]};
Hash:
PUBLIC
PROC [fn: IntFn, bounds: Interval ← []]
RETURNS [hash:
CARDINAL ← 0] ~ {
right: Space ~ fn.RightSpace[];
PerPair:
PROC [pair: IVPair] ~ {
vh: CARDINAL ← right.SpaceHash[pair.right];
ih: CARDINAL ← HashIntI[pair.left];
this: CARD;
IF ih=0 THEN ih ← 13;
IF vh=0 THEN vh ← 17;
this ← CARD[ih]*vh;
hash ← hash + HashIntI[LOOPHOLE[this]];
RETURN};
IF right=NIL THEN Cant[fn];
fn.Enumerate[PerPair, bounds];
RETURN};
Compare:
PUBLIC
PROC [a, b: IntFn, bounds: Interval ← []]
RETURNS [c: Basics.Comparison] ~ {
right: Space ~ a.RightSpace[];
aBounds: Interval ~ a.ImproveBounds[bounds];
bBounds: Interval ~ b.ImproveBounds[bounds];
IF right=NIL THEN Cant[a];
bounds ← MBI[aBounds, bBounds];
FOR i:
INT
IN [bounds.min .. bounds.max]
DO
amv: MaybeValue ~ a.Apply[i];
bmv: MaybeValue ~ b.Apply[i];
IF amv.found#bmv.found THEN RETURN [IF bmv.found THEN less ELSE greater];
IF amv.found AND (c ← right.SpaceCompare[amv.val, bmv.val])#equal THEN RETURN;
ENDLOOP;
c ← equal};
RestrictionKey:
ARRAY Restriction
OF
ATOM ~ [
unrestricted: $unrestricted,
filtered: $filtered,
restricted: $restricted,
tiny: $tiny];
FromRestriction:
PUBLIC
PROC [r: Restriction]
RETURNS [
ATOM]
~ {RETURN [RestrictionKey[r]]};
GetRestriction:
PUBLIC
PROC [args: ArgList, i:
NAT, default: Restriction ← unrestricted]
RETURNS [Restriction] ~ {
WHILE i>1 AND args#NIL DO args ← args.rest; i ← i-1 ENDLOOP;
IF args=NIL THEN RETURN [default];
RETURN [
SELECT args.first
FROM
$unrestricted => unrestricted,
$filtered => filtered,
$restricted => restricted,
$tiny => tiny,
ENDCASE => ERROR];
};
Start:
PROC ~ {
FOR isOneToOne:
BOOL
IN
BOOL
DO
FOR dense:
BOOL
IN
BOOL
DO
FOR domainFixed:
BOOL
IN
BOOL
DO
FOR mutability: Mutability
IN Mutability
DO
simpleClasses[isOneToOne][dense][domainFixed][mutability] ← CreateClass[
cp: [
Apply: SimpleApply,
Scan: SimpleScan,
GetBounds: SimpleGetBounds,
Copy: SimpleCopy,
Freeze: SimpleFreeze,
Thaw: SimpleThaw,
AddColl: SimpleAddColl,
RemColl: IF dense THEN SimpleDenseRemColl ELSE SimpleSparseRemColl,
ReplaceMe: SimpleReplaceMe,
ReshapeMe: SimpleReshapeMe,
RightSpace: SimpleRightSpace,
isOneToOne: isOneToOne,
isDense: dense,
ordered: TRUE,
mutability: mutability,
domainFixed: domainFixed
],
bkwdable: [TRUE, TRUE]
];
ENDLOOP ENDLOOP ENDLOOP ENDLOOP;
};
Start[];
END.