StdIntFunctions4.Mesa
Last tweaked by Mike Spreitzer on October 16, 1987 10:43:40 am PDT
DIRECTORY Basics, Collections, IntFunctions, IntStuff, PairCollections, List;
StdIntFunctions4:
CEDAR
PROGRAM
IMPORTS Collections, IntFunctions, IntStuff, PairCollections, List
EXPORTS IntFunctions
=
BEGIN OPEN PCs:PairCollections, Colls:Collections, Ints:IntStuff, Collections, PairCollections, IntStuff, IntFunctions;
AcceptAny:
PUBLIC
PROC [pair: IVPair]
RETURNS [pass:
BOOL ←
FALSE]
--Tester--
~ {RETURN [TRUE]};
Enumerate:
PUBLIC
PROC [fn: IntFn,
Consume:
PROC [IVPair], left: Interval ← [], right: Collection ← passAll, bkwd:
BOOL ←
FALSE] ~ {
Pass: PROC [pair: IVPair] RETURNS [pass: BOOL ← FALSE] ~ {Consume[pair]};
[] ← fn.Scan[Pass, left, right, bkwd];
};
AddPair:
PUBLIC
PROC [fn: IntFn, pair: IVPair, if: IfNewsPair ←
ALL[
ALL[
TRUE]]]
RETURNS [news: NewsPair] ~ {
some: NewsSetPair ~ fn.AddColl[CreateSingleton[pair, fn.RightSpace], if];
news ← ALL[different];
FOR dir: Direction
IN Direction
DO
FOR n: News
IN News
DO
IF some[dir][n] THEN news[dir] ← n;
ENDLOOP;
ENDLOOP;
RETURN};
refIntFns:
PUBLIC Space ~
NEW [SpacePrivate ← [
Equal: IntFnsEqual,
Hash: HashIntFn,
Compare: CompareIntFns,
other: List.PutAssoc[$Name, "ref IntFns", NIL]
]];
IntFnsEqual:
PROC [data:
REF
ANY, elt1, elt2: Value]
RETURNS [
BOOL] ~ {
if1: IntFn ~ DeRef[elt1];
if2: IntFn ~ DeRef[elt2];
RETURN Equal[if1, if2]};
HashIntFn:
PROC [data:
REF
ANY, elt: Value]
RETURNS [
CARDINAL] ~ {
if: IntFn ~ DeRef[elt];
RETURN Hash[if]};
CompareIntFns:
PROC [data:
REF
ANY, elt1, elt2: Value]
RETURNS [Basics.Comparison] ~ {
if1: IntFn ~ DeRef[elt1];
if2: IntFn ~ DeRef[elt2];
RETURN Compare[if1, if2]};
Wi:
PROC [i:
INT]
RETURNS [Value]
~ INLINE {RETURN [NEW [INT ← i]]};
Wp:
PROC [pair: IVPair]
RETURNS [Pair]
~ INLINE {RETURN [[NEW [INT ← pair.left], pair.right]]};
Wmi:
PROC [mi: MaybeInt]
RETURNS [MaybeValue]
~ INLINE {RETURN [IF mi.found THEN [TRUE, Wi[mi.i]] ELSE noMaybe]};
Wmp:
PROC [mp: MaybePair]
RETURNS [PCs.MaybePair]
~ INLINE {RETURN [IF mp.found THEN [TRUE, Wp[mp.pair]] ELSE PCs.noMaybePair]};
Ni:
PROC [i: Value]
RETURNS [
INT]
~ INLINE {RETURN [NARROW[i, REF INT]^]};
Np:
PROC [pair: Pair]
RETURNS [IVPair]
~ INLINE {RETURN [[Ni[pair[left]], pair[right]]]};
Nmi:
PROC [mv: MaybeValue]
RETURNS [MaybeInt]
~ INLINE {RETURN [IF mv.found THEN [TRUE, Ni[mv.val]] ELSE noInt]};
Nmp:
PROC [mp: PCs.MaybePair]
RETURNS [MaybePair]
~ INLINE {RETURN [IF mp.found THEN [TRUE, Np[mp.pair]] ELSE noMaybePair]};
PashClasses: TYPE ~ ARRAY --isOneToOne--BOOL OF ARRAY --isDense--BOOL OF ARRAY --ordered--BOOL OF ARRAY Mutability OF ARRAY --domainFixed--BOOL OF IntFnClass;
pashClasses: REF PashClasses ~ NEW[PashClasses];
CreatePartnership:
PUBLIC
PROC [a, b: IntFn]
RETURNS [IntFn] ~ {
p: Pash ~ NEW [PashPrivate ← [a, b]];
RETURN [[
pashClasses[a.IsOneToOne][a.class.isDense][a.Ordered][a.MutabilityOf][a.DomainIsFixed],
p]]};
Pash: TYPE ~ REF PashPrivate;
PashPrivate:
TYPE ~
RECORD [
a, b: IntFn
];
PashPrimitive:
PROC [fn: IntFn, op:
ATOM, args: ArgList ←
NIL]
RETURNS [PrimitiveAnswer] ~ {
p: Pash ~ NARROW[fn.data];
SELECT op
FROM
$HasPair, $Apply, $Get3, $Index, $GetBounds, $ImproveBounds, $RightCollection, $CurRange, $RightSpace => RETURN [IF p.a.QualityOf[op, args]>=goodDefault THEN yes ELSE no];
$Extremum => RETURN [IF p.a.QualityOf[op, args]>=goodDefault AND ((NOT GetBool[args, 2]) OR fn.QualityOf[$RemPair]>=goodDefault) THEN yes ELSE no];
$Scan => RETURN [IF QualityOf[(IF GetRestriction[args,1]<GetRestriction[args,2] AND (p.b.Ordered OR (NOT fn.Ordered) OR (fn.IsOneToOne AND GetRestriction[args,2]=tiny)) THEN p.b ELSE p.a), op, args]>=goodDefault THEN yes ELSE no];
$Size => RETURN [IF QualityOf[(IF GetRestriction[args,1]<GetRestriction[args,2] THEN p.b ELSE p.a), op, args]>=goodDefault THEN yes ELSE no];
$InvApply => RETURN [IF p.b.QualityOf[op, args]>=goodDefault THEN yes ELSE no];
$Copy, $Insulate, $ValueOf, $Freeze, $Thaw, $AddColl, $RemColl, $RightDeleteColl, $ReplaceMe, $ReshapeMe, $Swap => RETURN [IF p.a.Can[op, args] AND p.b.Can[op, args] THEN yes ELSE no];
ENDCASE => RETURN [pass];
PashHasPair:
PROC [fn: IntFn, pair: IVPair]
RETURNS [
BOOL] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.a.HasPair[pair]};
PashApply:
PROC [fn: IntFn, i:
INT]
RETURNS [MaybeValue] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.a.Apply[i]};
PashInvApply:
PROC [fn: IntFn, v: Value]
RETURNS [MaybeInt] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.b.InvApply[v]};
PashScan:
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [MaybePair] ~ {
p: Pash ~ NARROW[fn.data];
leftSize: EINT ~ left.Length;
rightSize: EINT ~ IF right.QualityOf[$Size] >= goodDefault THEN IE[right.Size[]] ELSE maxIntervalLength;
RETURN (IF leftSize.Compare[rightSize]=greater AND (p.b.Ordered OR (NOT fn.Ordered) OR (fn.IsOneToOne AND rightSize.Compare[one]<=equal)) THEN p.b ELSE p.a).Scan[Test, left, right, bkwd]};
PashExtremum:
PROC [fn: IntFn, bkwd, remove:
BOOL]
RETURNS [mp: MaybePair] ~ {
p: Pash ~ NARROW[fn.data];
mp ← p.a.Extremum[bkwd, FALSE];
IF mp.found
AND remove
THEN {
had: BoolPair ~ fn.RemPair[mp.pair];
IF (NOT had[leftToRight]) OR (fn.IsOneToOne[] AND NOT had[rightToLeft]) THEN ERROR;
};
RETURN};
PashGet3:
PROC [fn: IntFn, pair: IVPair]
RETURNS [prev, same, next: MaybePair] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.a.Get3[pair]};
PashIndex:
PROC [fn, goal: IntFn, bounds: Interval, bkwd:
BOOL]
RETURNS [MaybeInt] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.a.Index[goal, bounds, bkwd]};
PashSize:
PROC [fn: IntFn, left: Interval, right: Collection, limit:
LNAT]
RETURNS [
LNAT] ~ {
p: Pash ~ NARROW[fn.data];
leftSize: EINT ~ left.Length;
rightSize: EINT ~ IF right.QualityOf[$Size] >= goodDefault THEN IE[right.Size[]] ELSE maxIntervalLength;
RETURN (IF leftSize.Compare[rightSize]=greater THEN p.b ELSE p.a).Size[left, right, limit]};
PashGetBounds:
PROC [fn: IntFn]
RETURNS [Interval] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.a.GetBounds[]};
PashImproveBounds:
PROC [fn: IntFn, bounds: Interval]
RETURNS [Interval] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.a.ImproveBounds[bounds]};
PashCopy:
PROC [fn: IntFn]
RETURNS [VarIntFn] ~ {
p: Pash ~ NARROW[fn.data];
RETURN CreatePartnership[p.a.Copy, p.b.Copy].AsVar};
PashInsulate:
PROC [fn: IntFn]
RETURNS [UWIntFn] ~ {
p: Pash ~ NARROW[fn.data];
RETURN CreatePartnership[p.a.Insulate, p.b.Insulate].AsUW};
PashValueOf:
PROC [fn: IntFn]
RETURNS [ConstIntFn] ~ {
p: Pash ~ NARROW[fn.data];
RETURN CreatePartnership[p.a.ValueOf, p.b.ValueOf].AsConst};
PashFreeze:
PROC [fn: IntFn]
RETURNS [ConstIntFn] ~ {
p: Pash ~ NARROW[fn.data];
RETURN CreatePartnership[p.a.Freeze, p.b.Freeze].AsConst};
PashThaw:
PROC [fn: IntFn] ~ {
p: Pash ~ NARROW[fn.data];
p.a.Thaw[];
p.b.Thaw[];
RETURN};
PashAddColl:
PROC [fn, other: IntFn, if: IfNewsPair]
RETURNS [some: NewsSetPair] ~ {
p: Pash ~ NARROW[fn.data];
some ← [
leftToRight: p.a.AddColl[other, if].some[leftToRight],
rightToLeft: p.b.AddColl[other, if].some[rightToLeft]];
RETURN};
PashRemColl:
PROC [fn, other: IntFn]
RETURNS [hadSome, hadAll: BoolPair] ~ {
p: Pash ~ NARROW[fn.data];
o2: IntFn ~ IF other=fn THEN p.b ELSE other;
sum, all: BoolPair;
[hadSome, hadAll] ← p.a.RemColl[other];
[sum, all] ← p.a.RemColl[o2];
hadSome[rightToLeft] ← sum[rightToLeft];
hadAll[rightToLeft] ← all[rightToLeft];
RETURN};
PashRightDeleteColl:
PROC [fn: IntFn, coll: Collection, style: RemoveStyle]
RETURNS [hadSome, hadAll:
BOOL] ~ {
p: Pash ~ NARROW[fn.data];
sum, all: BOOL;
[hadSome, hadAll] ← p.a.RightDeleteColl[coll, style];
[sum, all] ← p.b.RightDeleteColl[coll, style];
IF sum#hadSome OR all#hadAll THEN ERROR;
RETURN};
PashReplaceMe:
PROC [fn, with: IntFn, where, clip: Interval]
RETURNS [losses, gains:
EINT] ~ {
p: Pash ~ NARROW[fn.data];
l2, g2: EINT;
TRUSTED {
[losses, gains] ← p.a.ReplaceMe[with, where, clip];
[l2, g2] ← p.b.ReplaceMe[with, where, clip]};
IF l2#losses OR g2#gains THEN ERROR;
RETURN};
PashReshapeMe:
PROC [fn: IntFn, lt: XForm, lb: Interval, rt: OneToOne, rb: Collection] ~ {
p: Pash ~ NARROW[fn.data];
p.a.ReshapeMe[lt, lb, rt, rb];
p.b.ReshapeMe[lt, lb, rt, rb];
RETURN};
PashSwap:
PROC [fn: IntFn, i, j:
INT] ~ {
p: Pash ~ NARROW[fn.data];
p.a.Swap[i, j];
p.b.Swap[i, j];
RETURN};
PashRightCollection:
PROC [fn: IntFn]
RETURNS [UWColl] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.a.RightCollection[]};
PashCurRange:
PROC [fn: IntFn]
RETURNS [ConstSet] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.a.CurRange[]};
PashRightSpace:
PROC [fn: IntFn]
RETURNS [Space] ~ {
p: Pash ~ NARROW[fn.data];
RETURN p.a.RightSpace[]};
Start:
PROC ~ {
FOR isOneToOne:
BOOL
IN
BOOL
DO
FOR ordered:
BOOL
IN
BOOL
DO
FOR isDense:
BOOL
IN
BOOL
DO
FOR domainFixed:
BOOL
IN
BOOL
DO
pashClasses[isOneToOne][isDense][ordered][constant][domainFixed] ← CreateClass[[
Primitive: PashPrimitive,
HasPair: PashHasPair,
Apply: PashApply,
InvApply: PashInvApply,
Scan: PashScan,
Extremum: PashExtremum,
Get3: PashGet3,
Index: PashIndex,
Size: PashSize,
GetBounds: PashGetBounds,
ImproveBounds: PashImproveBounds,
Copy: PashCopy,
RightCollection: PashRightCollection,
CurRange: PashCurRange,
RightSpace: PashRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: constant,
domainFixed: domainFixed
]];
pashClasses[isOneToOne][isDense][ordered][readonly][domainFixed] ← CreateClass[[
Primitive: PashPrimitive,
HasPair: PashHasPair,
Apply: PashApply,
InvApply: PashInvApply,
Scan: PashScan,
Extremum: PashExtremum,
Get3: PashGet3,
Index: PashIndex,
Size: PashSize,
GetBounds: PashGetBounds,
ImproveBounds: PashImproveBounds,
Copy: PashCopy,
ValueOf: PashValueOf,
RightCollection: PashRightCollection,
CurRange: PashCurRange,
RightSpace: PashRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: readonly,
domainFixed: domainFixed
]];
pashClasses[isOneToOne][isDense][ordered][variable][domainFixed] ← CreateClass[[
Primitive: PashPrimitive,
HasPair: PashHasPair,
Apply: PashApply,
InvApply: PashInvApply,
Scan: PashScan,
Extremum: PashExtremum,
Get3: PashGet3,
Index: PashIndex,
Size: PashSize,
GetBounds: PashGetBounds,
ImproveBounds: PashImproveBounds,
Copy: PashCopy,
Insulate: PashInsulate,
ValueOf: PashValueOf,
Freeze: PashFreeze,
Thaw: PashThaw,
AddColl: PashAddColl,
RemColl: PashRemColl,
RightDeleteColl: PashRightDeleteColl,
ReplaceMe: PashReplaceMe,
ReshapeMe: PashReshapeMe,
Swap: PashSwap,
RightCollection: PashRightCollection,
CurRange: PashCurRange,
RightSpace: PashRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: variable,
domainFixed: domainFixed
]];
ENDLOOP ENDLOOP ENDLOOP ENDLOOP;
};
Start[];
END.