StdIntFunctions7.Mesa
Last tweaked by Mike Spreitzer on October 19, 1987 1:47:15 pm PDT
DIRECTORY Atom, Basics, Collections, IntFunctions, IntStuff, PairCollections, List, RuntimeError;
StdIntFunctions7:
CEDAR
PROGRAM
IMPORTS Collections, IntFunctions, PairCollections
EXPORTS IntFunctions
=
BEGIN OPEN PCs:PairCollections, Colls:Collections, Ints:IntStuff, Collections, PairCollections, IntStuff, IntFunctions;
Compose:
PUBLIC
PROC [left: IntFn, right: Function, leftRestricts, rightRestricts:
BOOL ←
TRUE]
RETURNS [IntFn] ~ {
oneToOne: BOOL ~ left.IsOneToOne AND right.Functional[][rightToLeft];
isDense: BOOL ~ left.class.isDense AND NOT rightRestricts;
ordered: BOOL ~ left.Ordered;
mutability: UnwriteableMutability ~ IF left.MutabilityOf=constant AND right.MutabilityOf=constant THEN constant ELSE readonly;
domainFixed: BOOL ~ left.DomainIsFixed;
canSizeLeft: BOOL ~ NOT rightRestricts;
canSizeRight: BOOL ~ left.IsOneToOne AND NOT leftRestricts;
comp: Comp ~
NEW [CompPrivate ← [
left, right,
leftRestricts, rightRestricts,
canSizeLeft, canSizeRight,
IF oneToOne AND right.QualityOf[$Apply, LIST[$rightToLeft]]>left.QualityOf[$Apply] THEN rightToLeft ELSE leftToRight
]];
RETURN [[
compClasses
[oneToOne]
[isDense]
[ordered]
[mutability]
[domainFixed]
[leftRestricts]
[rightRestricts]
[comp.canSizeLeft OR comp.canSizeRight],
comp]];
};
Classes: TYPE ~ ARRAY --oneToOne--BOOL OF ARRAY --isDense--BOOL OF ARRAY --ordered--BOOL OF ARRAY UnwriteableMutability OF ARRAY --domainFixed--BOOL OF ARRAY --leftRestricts--BOOL OF ARRAY --rightRestricts--BOOL OF ARRAY --canSize--BOOL OF IntFnClass;
compClasses: REF Classes ~ NEW[Classes];
Comp: TYPE ~ REF CompPrivate;
CompPrivate:
TYPE ~
RECORD [
left: IntFn,
right: PairColl,
leftRestricts, rightRestricts, canSizeLeft, canSizeRight: BOOL,
applyDir: Direction
];
CompPrimitive:
PROC [fn: IntFn, op:
ATOM, args: ArgList ←
NIL]
RETURNS [PrimitiveAnswer] ~ {
comp: Comp ~ NARROW[fn.data];
SELECT op
FROM
$Widen => RETURN [IF comp.left.Can[op, args] THEN yes ELSE no];
$HasPair =>
RETURN [
SELECT comp.applyDir
FROM
leftToRight => IF comp.left.QualityOf[$Apply]>=goodDefault AND comp.right.QualityOf[$HasPair]>=goodDefault THEN yes ELSE no,
rightToLeft => IF comp.right.QualityOf[$Apply, LIST[$rightToLeft]]>=goodDefault AND comp.left.QualityOf[$HasPair]>=goodDefault THEN yes ELSE no,
ENDCASE => ERROR];
$Apply => RETURN [IF comp.left.QualityOf[op, args]>=goodDefault AND comp.right.QualityOf[op, args]>=goodDefault THEN yes ELSE no];
$InvApply => RETURN [IF comp.left.QualityOf[op, args]>=goodDefault AND comp.right.QualityOf[$Apply, LIST[$rightToLeft]]>=goodDefault THEN yes ELSE no];
$Scan => RETURN [IF comp.left.Can[$Scan] AND comp.right.Can[$Apply] THEN yes ELSE no];
$Extremum => RETURN [IF GetBool[args, 2] OR (comp.left.QualityOf[op, args]>=goodDefault AND comp.right.QualityOf[$Apply]>=goodDefault AND NOT comp.rightRestricts) THEN yes ELSE no];
$Get3 => RETURN [IF comp.left.QualityOf[op, args]>=goodDefault AND comp.right.QualityOf[$Apply]>=goodDefault AND NOT comp.rightRestricts THEN yes ELSE no];
$Size =>
RETURN [
IF comp.canSizeLeft AND GetRestriction[args, 2]=tiny AND comp.left.QualityOf[op, args]>=goodDefault THEN yes
ELSE IF comp.canSizeRight AND GetRestriction[args, 1]=tiny AND GetRestriction[args, 2]=tiny AND comp.right.QualityOf[op]>=goodDefault THEN yes
ELSE no];
$GetBounds => RETURN [IF comp.left.QualityOf[op, args]>=goodDefault AND NOT comp.rightRestricts THEN yes ELSE no];
$ValueOf => RETURN [IF comp.left.Can[op, args] AND comp.right.Can[op, args] THEN yes ELSE no];
$RightCollection, $CurRange => RETURN [IF comp.right.QualityOf[op, args]>=goodDefault AND NOT comp.leftRestricts THEN yes ELSE no];
$RightSpace => RETURN [IF comp.right.Can[op, args] THEN yes ELSE no];
ENDCASE => RETURN [pass];
};
CompWiden:
PROC [fn: IntFn]
RETURNS [Function
--[left]: REF INT--] ~ {
comp: Comp ~ NARROW[fn.data];
RETURN PCs.Compose[[comp.left.Widen, comp.right], [comp.leftRestricts, comp.rightRestricts]]};
CompHasPair:
PROC [fn: IntFn, pair: IVPair]
RETURNS [
BOOL] ~ {
comp: Comp ~ NARROW[fn.data];
SELECT comp.applyDir
FROM
leftToRight => {
mv: MaybeValue ~ comp.left.Apply[pair.left];
RETURN [mv.found AND comp.right.HasPair[[mv.val, pair.right]]]};
rightToLeft => {
mv: MaybeValue ~ comp.right.Apply[pair.right, rightToLeft];
RETURN [mv.found AND comp.left.HasPair[[pair.left, mv.val]]];
};
ENDCASE => ERROR;
};
CompApply:
PROC [fn: IntFn, i:
INT]
RETURNS [MaybeValue] ~ {
comp: Comp ~ NARROW[fn.data];
mv: MaybeValue ~ comp.left.Apply[i];
IF NOT mv.found THEN RETURN [mv];
RETURN comp.right.Apply[mv.val]};
CompInvApply:
PROC [fn: IntFn, v: Value]
RETURNS [MaybeInt] ~ {
comp: Comp ~ NARROW[fn.data];
mv: MaybeValue ~ comp.right.Apply[v, rightToLeft];
IF NOT mv.found THEN RETURN [noInt];
RETURN comp.left.InvApply[mv.val]};
CompScan:
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [mp: MaybePair ← noMaybePair] ~ {
comp: Comp ~ NARROW[fn.data];
Pass:
PROC [pair: IVPair]
RETURNS [pass:
BOOL] ~ {
mv: MaybeValue ~ comp.right.Apply[pair.right];
IF (pass ← mv.found AND right.HasMember[mv.val] AND Test[[pair.left, mv.val]]) THEN mp ← [TRUE, [pair.left, mv.val]];
RETURN};
[] ← comp.left.Scan[Test: Pass, left: left, bkwd: bkwd];
RETURN};
Complete:
PROC [comp: Comp, mp: MaybePair]
RETURNS [MaybePair] ~ {
IF NOT mp.found THEN RETURN [mp];
mp.pair.right ← comp.right.Apply[mp.pair.right].Val;
RETURN [mp]};
CompExtremum:
PROC [fn: IntFn, bkwd, remove:
BOOL]
RETURNS [MaybePair] ~ {
comp: Comp ~ NARROW[fn.data];
IF remove THEN fn.Complain[notVariable];
RETURN Complete[comp, comp.left.Extremum[bkwd, remove]]};
CompGet3:
PROC [fn: IntFn, pair: IVPair]
RETURNS [prev, same, next: MaybePair] ~ {
comp: Comp ~ NARROW[fn.data];
[prev, same, next] ← comp.left.Get3[pair];
prev ← Complete[comp, prev];
same ← Complete[comp, same];
next ← Complete[comp, next];
RETURN};
CompSize:
PROC [fn: IntFn, left: Interval ← [], right: Collection ← passAll, limit:
LNAT]
RETURNS [
LNAT] ~ {
comp: Comp ~ NARROW[fn.data];
IF comp.canSizeLeft AND right=passAll THEN RETURN comp.left.Size[left, right, limit];
IF comp.canSizeRight AND left=[] AND right=passAll THEN RETURN comp.right.Size[limit];
RETURN DefaultSize[fn, left, right, limit]};
CompGetBounds:
PROC [fn: IntFn]
RETURNS [Interval] ~ {
comp: Comp ~ NARROW[fn.data];
RETURN comp.left.GetBounds};
CompCopy:
PROC [fn: IntFn]
RETURNS [VarIntFn] ~ {
comp: Comp ~ NARROW[fn.data];
RETURN comp.left.Copy.Compose[comp.right.Copy, comp.leftRestricts, comp.rightRestricts].AsVar};
CompInsulate:
PROC [fn: IntFn]
RETURNS [UWIntFn] ~ {
comp: Comp ~ NARROW[fn.data];
RETURN comp.left.Insulate.Compose[comp.right.Insulate, comp.leftRestricts, comp.rightRestricts].AsUW};
CompValueOf:
PROC [fn: IntFn]
RETURNS [ConstIntFn] ~ {
comp: Comp ~ NARROW[fn.data];
RETURN comp.left.ValueOf.Compose[comp.right.ValueOf, comp.leftRestricts, comp.rightRestricts].AsConst};
CompFreeze:
PROC [fn: IntFn]
RETURNS [const: ConstIntFn] ~ {
comp: Comp ~ NARROW[fn.data];
left: IntFn ~ IF comp.left.MutabilityOf#constant THEN comp.left.Freeze ELSE comp.left;
right: PairColl ~ IF comp.right.MutabilityOf#constant THEN comp.right.Freeze ELSE comp.right;
RETURN left.Compose[right, comp.leftRestricts, comp.rightRestricts].AsConst};
CompThaw:
PROC [fn: IntFn] ~ {
comp: Comp ~ NARROW[fn.data];
IF comp.left.MutabilityOf#constant THEN comp.left.Thaw[];
IF comp.right.MutabilityOf#constant THEN comp.right.Thaw[];
RETURN};
CompRightCollection:
PROC [fn: IntFn]
RETURNS [UWColl] ~ {
comp: Comp ~ NARROW[fn.data];
RETURN comp.right.CollectionOn[right]};
CompCurRange:
PROC [fn: IntFn]
RETURNS [ConstSet] ~ {
comp: Comp ~ NARROW[fn.data];
RETURN comp.right.CurSetOn[right]};
CompRightSpace:
PROC [fn: IntFn]
RETURNS [Space] ~ {
comp: Comp ~ NARROW[fn.data];
RETURN [comp.right.Spaces[][right]]};
Start:
PROC ~ {
FOR oneToOne:
BOOL
IN
BOOL
DO
FOR isDense:
BOOL
IN
BOOL
DO
FOR ordered:
BOOL
IN
BOOL
DO
FOR domainFixed:
BOOL
IN
BOOL
DO
FOR leftRestricts:
BOOL
IN
BOOL
DO
FOR rightRestricts:
BOOL
IN
BOOL
DO
FOR canSize:
BOOL
IN
BOOL
DO
FOR mutability: UnwriteableMutability
IN UnwriteableMutability
DO
compClasses[oneToOne][isDense][ordered][mutability][domainFixed][leftRestricts][rightRestricts][canSize] ← CreateClass[[
Primitive: CompPrimitive,
Widen: CompWiden,
HasPair: CompHasPair,
Apply: CompApply,
InvApply: CompInvApply,
Scan: CompScan,
Extremum: IF NOT rightRestricts THEN CompExtremum ELSE NIL,
Get3: IF NOT rightRestricts THEN CompGet3 ELSE NIL,
Size: IF canSize THEN CompSize ELSE NIL,
GetBounds: IF NOT rightRestricts THEN CompGetBounds ELSE NIL,
ValueOf: CompValueOf,
RightCollection: IF NOT leftRestricts THEN CompRightCollection ELSE NIL,
CurRange: IF NOT leftRestricts THEN CompCurRange ELSE NIL,
RightSpace: CompRightSpace,
isOneToOne: oneToOne,
isDense: isDense,
ordered: ordered,
mutability: mutability,
domainFixed: domainFixed]];
ENDLOOP ENDLOOP ENDLOOP ENDLOOP ENDLOOP ENDLOOP ENDLOOP ENDLOOP;
};
Start[];
END.