IntFunctionsImpl.Mesa
Last tweaked by Mike Spreitzer on November 17, 1987 7:09:12 pm PST
DIRECTORY Atom, Basics, Collections, IntFunctions, IntStuff, PairCollections, List;
IntFunctionsImpl:
CEDAR
PROGRAM
IMPORTS Atom, Collections, IntFunctions, IntStuff, PairCollections, List
EXPORTS IntFunctions
=
BEGIN OPEN PCs:PairCollections, Colls:Collections, Ints:IntStuff, Collections, PairCollections, IntStuff, IntFunctions;
Cant: PUBLIC ERROR [fn: IntFn] ~ CODE;
Escape: ERROR = CODE;
provisionKey: ATOM ~ $IntFnsImplProvision;
bkwdableKey: ATOM ~ $IntFnsImplBkwdable;
kindKey: ATOM ~ $IntFnsImplKind;
fixedDomain: PUBLIC ROPE ~ BeRope["can't because %g's domain is fixed"];
noPair: PUBLIC IVPair ~ [INT.FIRST, noValue];
noMaybePair: PUBLIC MaybePair ~ [FALSE, noPair];
noInt: PUBLIC MaybeInt ~ [FALSE, noPair.left];
CreateClass:
PUBLIC
PROC [cp: IntFnClassPrivate, bkwdable:
BB ← [
TRUE,
FALSE]]
RETURNS [class: IntFnClass] ~ {
provs: Atom.PropList ← NARROW[List.Assoc[key: provisionKey, aList: cp.other]];
Sp:
PROC [op:
ATOM, def:
BOOL]
RETURNS [
BOOL] ~ {
provs ← List.PutAssoc[op, IF def THEN $Default ELSE $Primitive, provs];
RETURN [def]};
{OPEN cp;
IF Sp[$Widen, Widen=NIL] THEN Widen ← DefaultWiden;
IF Sp[$HasPair, HasPair=NIL] THEN HasPair ← DefaultHasPair;
IF Sp[$Apply, Apply=NIL] THEN Apply ← DefaultApply;
IF Sp[$InvApply, InvApply=NIL] THEN InvApply ← DefaultInvApply;
IF Sp[$Scan, Scan=NIL] THEN Scan ← DefaultScan;
IF Sp[$Extremum, Extremum=NIL] THEN Extremum ← DefaultExtremum;
IF Sp[$Get3, Get3=NIL] THEN Get3 ← DefaultGet3;
IF Sp[$Index, Index=NIL] THEN Index ← DefaultIndex;
IF Sp[$Size, Size=NIL] THEN Size ← DefaultSize;
IF Sp[$GetBounds, GetBounds=NIL] THEN GetBounds ← DefaultGetBounds;
IF Sp[$ImproveBounds, ImproveBounds=NIL] THEN ImproveBounds ← DefaultImproveBounds;
IF Sp[$Copy, Copy=NIL] THEN Copy ← DefaultCopy;
IF Sp[$Insulate, Insulate=NIL] THEN Insulate ← DefaultInsulate;
IF Sp[$ValueOf, ValueOf=NIL] THEN ValueOf ← DefaultValueOf;
IF Sp[$Freeze, Freeze=NIL] THEN Freeze ← DefaultFreeze;
IF Sp[$Thaw, Thaw=NIL] THEN Thaw ← DefaultThaw;
IF Sp[$AddColl, AddColl=NIL] THEN AddColl ← DefaultAddColl;
IF Sp[$RemColl, RemColl=NIL] THEN RemColl ← DefaultRemColl;
IF Sp[$RightDeleteColl, RightDeleteColl=NIL] THEN RightDeleteColl ← DefaultRightDeleteColl;
IF Sp[$ReplaceMe, ReplaceMe=NIL] THEN ReplaceMe ← DefaultReplaceMe;
IF Sp[$ReshapeMe, ReshapeMe=NIL] THEN ReshapeMe ← DefaultReshapeMe;
IF Sp[$Swap, Swap=NIL] THEN Swap ← DefaultSwap;
IF Sp[$RightCollection, RightCollection=NIL] THEN RightCollection ← DefaultRightCollection;
IF Sp[$CurRange, CurRange=NIL] THEN CurRange ← DefaultCurRange;
IF Sp[$RightSpace, RightSpace=NIL] THEN RightSpace ← DefaultRightSpace;
};
cp.other ← List.PutAssoc[provisionKey, provs, cp.other];
cp.other ← List.PutAssoc[bkwdableKey, NEW [BB ← bkwdable], cp.other];
class ← NEW [IntFnClassPrivate ← cp];
};
Primitive:
PROC [fn: IntFn, op:
ATOM, args: ArgList ←
NIL]
RETURNS [
BOOL] ~ {
kind: REF ANY ~ Atom.GetProp[atom: op, prop: kindKey];
SELECT kind
FROM
$class, $classB, $classBR, $classB3 => NULL;
ENDCASE => ERROR;
IF fn.class.Primitive #
NIL
THEN
SELECT fn.class.Primitive[fn, op, args]
FROM
yes => RETURN [TRUE];
no => RETURN [FALSE];
pass => NULL;
ENDCASE => ERROR;
{provs: Atom.PropList ~ NARROW[List.Assoc[key: provisionKey, aList: fn.class.other]];
prov: REF ANY ~ List.Assoc[op, provs];
bkwdable: REF BB ~ NARROW[List.Assoc[bkwdableKey, fn.class.other]];
RETURN [
SELECT prov
FROM
$Default => FALSE,
$Primitive =>
SELECT kind
FROM
$class => TRUE,
$classB => bkwdable[GetBool[args, 1]],
$classBR => (fn.MutabilityOf[]#variable AND GetBool[args, 2]) OR bkwdable[GetBool[args, 1]],
$classB3 => bkwdable[GetBool[args, 3]],
ENDCASE => ERROR,
ENDCASE => ERROR];
}};
QualityOf:
PUBLIC
PROC [fn: IntFn, op:
ATOM, args: ArgList ←
NIL]
RETURNS [ImplQuality] ~ {
SELECT Atom.GetProp[atom: op, prop: kindKey]
FROM
$class, $classB, $classBR, $classB3 => NULL;
$composite =>
SELECT op
FROM
$Enumerate => RETURN QualityOf[fn, $Scan, args];
$First => RETURN QualityOf[fn, $Extremum, LIST[$FALSE, $FALSE]];
$Last => RETURN QualityOf[fn, $Extremum, LIST[$TRUE, $FALSE]];
$Pop => RETURN QualityOf[fn, $Extremum, LIST[FromBool[GetBool[args, 1]], $TRUE]];
$Next => RETURN QMin[QualityOf[fn, $Get3], goodDefault];
$Prev => RETURN QMin[QualityOf[fn, $Get3], goodDefault];
$SkipTo => RETURN QualityOf[fn, $Scan, CONS[$filter, args]];
$Lookup => RETURN QualityOf[fn, $SkipTo, args];
$Empty =>
RETURN [
SELECT QualityOf[fn, $Size]
FROM
primitive => primitive,
goodDefault, poorDefault => goodDefault,
cant => cant,
ENDCASE => ERROR];
$AddPair => RETURN QualityOf[fn, $AddColl, args];
$Store => RETURN QualityOf[fn, $AddColl, args];
$RemPair => RETURN QualityOf[fn, $RemColl, args];
$LeftDelete => RETURN QualityOf[fn, $ReplaceMe, args];
$RightDelete => RETURN QualityOf[fn, $RightDeleteColl, args];
$Insert => RETURN QualityOf[fn, $ReplaceMe, args];
$Append => RETURN QualityOf[fn, $ReplaceMe, args];
$Remove => RETURN QualityOf[fn, $ReplaceMe, args];
ENDCASE => ERROR;
ENDCASE => ERROR;
IF Primitive[fn, op, args] THEN RETURN [primitive];
RETURN [
SELECT op
FROM
$Widen => cant,
$HasPair =>
IF fn.RightSpace=NIL THEN cant
ELSE IF Primitive[fn, $Apply] OR fn.IsOneToOne AND Primitive[fn, $InvApply] THEN goodDefault
ELSE QMin[goodDefault, fn.QualityOf[$Scan, LIST[$tiny, $tiny]]],
$Apply => QMin[goodDefault, QualityOf[fn, $Scan, LIST[$tiny]]],
$InvApply => QMin[goodDefault, QualityOf[fn, $Scan, LIST[$unrestricted, $tiny]]],
$Scan => QMax[
IF GetRestriction[args, 2]>GetRestriction[args, 1] AND (GetRestriction[args, 2]=tiny OR NOT fn.Ordered) AND fn.IsOneToOne AND Primitive[fn, $InvApply] AND GetRestriction[args, 2]>=restricted THEN goodDefault ELSE cant,
IF NOT (QualityOf[fn, $ImproveBounds]>=goodDefault AND Primitive[fn, $Apply]) THEN cant ELSE IF GetRestriction[args, 2]>=restricted THEN poorDefault ELSE goodDefault],
$Extremum => QMin[IF fn.QualityOf[$Scan, CONS[$unrestricted, CONS[$unrestricted, args]]]>=goodDefault THEN goodDefault ELSE poorDefault, IF GetBool[args, 2] THEN fn.QualityOf[$RemPair] ELSE goodDefault],
$Get3 => IF QualityOf[fn, $RightSpace]=cant THEN cant ELSE QMin[poorDefault, QMax[QualityOf[fn, $Scan, LIST[$TRUE]], QualityOf[fn, $Scan, LIST[$FALSE]]]],
$Index => QMin[QMin[QualityOf[fn, $Scan, LIST[$restricted]], QualityOf[fn, $Apply]], goodDefault],
$Size => QMin[QualityOf[fn, $Scan, args], poorDefault],
$GetBounds => IF QualityOf[fn, $Extremum, LIST[$FALSE]]>=goodDefault AND QualityOf[fn, $Extremum, LIST[$TRUE]]>=goodDefault AND fn.Ordered[] THEN goodDefault ELSE QMin[QualityOf[fn, $Scan], poorDefault],
$ImproveBounds => IF Primitive[fn, $GetBounds] THEN goodDefault ELSE poorDefault,
$Copy => cant,
$Insulate => goodDefault,
$ValueOf => IF fn.class.mutability=constant THEN goodDefault ELSE QMin[poorDefault, QMin[QualityOf[fn, $Copy], QualityOf[fn, $Freeze]]],
$Freeze, $Thaw => IF fn.MutabilityOf=variable THEN cant ELSE ERROR,
$AddColl, $RemoveColl, $RightDeleteColl, $ReplaceMe => IF fn.MutabilityOf=variable THEN cant ELSE goodDefault,
$ReshapeMe => QMin[QMin[poorDefault, QMin[QualityOf[fn, $AddPair], QualityOf[fn, $LeftDelete]]], QMin[QualityOf[fn, $RemPair], QMin[QualityOf[fn, $Scan], QualityOf[fn, $Apply]]]],
$Swap => QMin[QMin[goodDefault, QualityOf[fn, $Apply]], QMin[QualityOf[fn, $AddPair], QualityOf[fn, $LeftDelete]]],
$RightCollection => cant,
$CurRange => cant,
$RightSpace => cant,
ENDCASE => ERROR];
};
DefaultHasPair:
PUBLIC
PROC [fn: IntFn, pair: IVPair]
RETURNS [has:
BOOL] ~ {
goal: IVPair ~ pair;
right: Space ~ fn.RightSpace;
IF right=NIL THEN Cant[fn]
ELSE IF Primitive[fn, $Apply] THEN {appl: MaybeValue ~ fn.Apply[pair.left]; has ← appl.found AND right.SpaceEqual[appl.val, pair.right]}
ELSE IF fn.IsOneToOne AND Primitive[fn, $InvApply] THEN {appl: MaybeInt ~ fn.InvApply[pair.right]; has ← appl.found AND pair.left=appl.i}
ELSE has ← fn.Scan[AcceptAny, [pair.left, pair.left], Colls.CreateSingleton[pair.right, right]].found;
RETURN};
DefaultApply:
PROC [fn: IntFn, i:
INT]
RETURNS [MaybeValue] ~ {
RETURN fn.Scan[AcceptAny, [i, i]].DropKey;
};
DefaultInvApply:
PROC [fn: IntFn, v: Value]
RETURNS [MaybeInt] ~ {
RETURN fn.Scan[Test: AcceptAny, right: Colls.CreateSingleton[v, fn.RightSpace]].DropVal;
};
DefaultScan:
PUBLIC
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [mp: MaybePair] ~ {
leftSize: EINT ~ left.Length;
rightSize: EINT ~ IF right.Can[$Size] THEN IE[right.Size[leftSize.ClipN]] ELSE maxIntervalLength;
IF leftSize.Compare[rightSize]=greater
AND (rightSize.Compare[one]<=equal
OR
NOT fn.Ordered)
AND fn.IsOneToOne
AND Primitive[fn, $InvApply]
AND right.Can[$Scan,
LIST[FromBool[bkwd]]]
THEN {
PerRight:
PROC [val: Value]
RETURNS [pass:
BOOL] ~ {
mi: MaybeInt ~ fn.InvApply[val];
IF (pass ← mi.found AND left.Contains[mi.i] AND Test[[mi.i, val]]) THEN mp ← [TRUE, [mi.i, val]];
RETURN};
[] ← right.Scan[PerRight, bkwd];
RETURN};
IF NOT (QualityOf[fn, $ImproveBounds]>=goodDefault AND Primitive[fn, $Apply]) THEN Cant[fn];
left ← fn.ImproveBounds[left];
IF bkwd
THEN {
FOR i:
INT
DECREASING
IN [left.min .. left.max]
DO
mv: MaybeValue ~ fn.Apply[i];
IF mv.found AND right.HasMember[mv.val] AND Test[[i, mv.val]] THEN RETURN [[TRUE, [i, mv.val]]];
ENDLOOP;
}
ELSE {
FOR i:
INT
IN [left.min .. left.max]
DO
mv: MaybeValue ~ fn.Apply[i];
IF mv.found AND right.HasMember[mv.val] AND Test[[i, mv.val]] THEN RETURN [[TRUE, [i, mv.val]]];
ENDLOOP;
};
RETURN [noMaybePair];
};
DefaultExtremum:
PUBLIC
PROC [fn: IntFn, bkwd, remove:
BOOL]
RETURNS [m: MaybePair] ~ {
Easy: PROC [val: IVPair] RETURNS [pass: BOOL ← FALSE] ~ {pass ← TRUE};
Hard: PROC [val: IVPair] RETURNS [pass: BOOL ← FALSE] ~ {m ← [TRUE, val]};
IF fn.QualityOf[$Scan, LIST[$unrestricted, $unrestricted, FromBool[bkwd]]] >= goodDefault THEN m ← fn.Scan[Test: Easy, bkwd: bkwd]
ELSE [] ← fn.Scan[Test: Hard, bkwd: NOT bkwd];
IF m.found
AND remove
THEN {
had: BoolPair ~ fn.RemPair[m.pair];
IF (NOT had[leftToRight]) OR (fn.IsOneToOne[] AND NOT had[rightToLeft]) THEN ERROR;
};
RETURN};
DefaultGet3:
PUBLIC
PROC [fn: IntFn, pair: IVPair]
RETURNS [prev, same, next: MaybePair] ~ {
fq: ImplQuality ~ fn.QualityOf[$Scan, LIST[$unrestricted, $unrestricted, $FALSE]];
bq: ImplQuality ~ fn.QualityOf[$Scan, LIST[$unrestricted, $unrestricted, $TRUE]];
bkwd: BOOL ~ bq > fq;
take: BOOL ← FALSE;
right: Space ~ fn.RightSpace[];
Pass:
PROC [val: IVPair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
IF val.left=pair.left AND right.SpaceEqual[val.right, pair.right] THEN same ← [take ← TRUE, pair]
ELSE IF take THEN pass ← TRUE
ELSE prev ← [TRUE, val];
};
IF right=NIL THEN Cant[fn];
prev ← same ← noMaybePair;
next ← fn.Scan[Test: Pass, bkwd: bkwd];
IF bkwd THEN RETURN [next, same, prev];
RETURN};
DefaultIndex:
PUBLIC
PROC [fn, goal: IntFn, bounds: Interval, bkwd:
BOOL]
RETURNS [mi: MaybeInt] ~ {
ENABLE Cant => Cant[fn];
right: Space ~ fn.RightSpace;
fnBounds: Interval ~ IF fn.QualityOf[$GetBounds] >= goodDefault THEN fn.GetBounds ELSE [];
goalBounds: Interval ~ goal.GetBounds;
goalLen: EINT ~ goalBounds.Length;
first: IVPair ~ IF NOT goalBounds.Empty THEN goal.First.P ELSE noPair;
scanBounds: Interval ~ Intersect[