BiRels.Mesa
Last tweaked by Mike Spreitzer on December 18, 1987 12:25:01 pm PST
DIRECTORY AbSets, Atom, Basics, BiRelBasics, IntStuff, SetBasics;
BiRels: CEDAR DEFINITIONS
IMPORTS AbSets, BiRelBasics, IntStuff, SetBasics
= {OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics;
Random Old Stuff
EINT: TYPE ~ IntStuff.EINT;
Value: TYPE ~ SetBasics.Value;
Interval: TYPE ~ SetBasics.Interval;
IntInterval: TYPE ~ SetBasics.IntInterval;
Set: TYPE ~ Sets.Set;
Direction: TYPE ~ Sets.Direction;
Side: TYPE ~ Sets.Side;
Pair: TYPE ~ BiRelBasics.Pair;
noPair: READONLY Pair;
LOP: TYPE ~ LIST OF Pair;
MaybePair: TYPE ~ BiRelBasics.MaybePair;
noMaybePair: READONLY MaybePair;
TripleMaybePair: TYPE ~ BiRelBasics.TripleMaybePair;
MaybePairInterval: TYPE ~ BiRelBasics.MaybePairInterval;
MaybePairSpace: TYPE ~ BiRelBasics.MaybePairSpace;
Had: TYPE ~ BiRelBasics.Had;
HadPair: TYPE ~ BiRelBasics.HadPair;
HadSetPair: TYPE ~ BiRelBasics.HadSetPair;
IfHad: TYPE ~ BiRelBasics.IfHad;
IfHadPair: TYPE ~ BiRelBasics.IfHadPair;
alwaysAdd: IfHadPair ~ BiRelBasics.alwaysAdd;
addIfNew: IfHadPair ~ BiRelBasics.addIfNew;
addIfOld: IfHadPair ~ BiRelBasics.addIfOld;
BoolPair: TYPE ~ BiRelBasics.BoolPair;
SpacePair: TYPE ~ BiRelBasics.SpacePair;
SetPair: TYPE ~ BiRelBasics.SetPair;
PairInterval: TYPE ~ BiRelBasics.PairInterval;
RelOrder: TYPE ~ BiRelBasics.RelOrder;
TotalRelOrder: TYPE ~ BiRelBasics.TotalRelOrder;
leftFwd: RelOrder ~ BiRelBasics.leftFwd;
leftBwd: RelOrder ~ BiRelBasics.leftBwd;
rightFwd: RelOrder ~ BiRelBasics.rightFwd;
rightBwd: RelOrder ~ BiRelBasics.rightBwd;
PairSpace: TYPE ~ BiRelBasics.PairSpace;
Binary Relations (i.e., Sets of Pairs)
BiRel: TYPE ~ RECORD [class: BiRelClass, data: REF ANY];
A binary relation (i.e., a set of Pairs), or a variable such.
ConsBiRel: PROC [class: BiRelClass, data: REF ANY] RETURNS [BiRel];
Good for calling from the interpreter.
nilBiRel: BiRel ~ [NIL, NIL];
badBiRel: READONLY BiRel;
DeRef: PROC [ra: REF ANY] RETURNS [BiRel]
~ INLINE {RETURN [IF ra#NIL THEN NARROW[ra, RefBiRel]^ ELSE nilBiRel]};
Refify: PROC [br: BiRel] RETURNS [RefBiRel]
~ INLINE {RETURN [NEW [BiRel ← br]]};
Operations on BiRels
Cant: ERROR [br: BiRel];
Raised when a BiRel is asked to perform an operation it can't.
AsSet: PROC [br: BiRel, ro: RelOrder] RETURNS [Set--of REF Pair--]
The ordering of the space of the result respects the relative order given.
~ INLINE {RETURN br.class.AsSet[br, ro]};
HasPair: PROC [br: BiRel, pair: Pair] RETURNS [BOOL]
~ INLINE {RETURN br.class.HasPair[br, pair]};
HasAA: PROC [br: BiRel, left, right: REF ANY] RETURNS [BOOL]
~ INLINE {RETURN br.class.HasPair[br, [AV[left], AV[right]]]};
HasIA: PROC [br: BiRel, left: INT, right: REF ANY] RETURNS [BOOL]
~ INLINE {RETURN br.class.HasPair[br, [IV[left], AV[right]]]};
HasII: PROC [br: BiRel, left, right: INT] RETURNS [BOOL]
~ INLINE {RETURN br.class.HasPair[br, [IV[left], IV[right]]]};
Image: PROC [br: BiRel, set: Set, dir: Direction ← leftToRight] RETURNS [Set]
For leftToRight, the result is henceforth the things that are on the right sides of pairs in br that have an element of set on their left side. The result tracks changes to br, and changes to the result change br (in any one of the possible ways).
~ INLINE {RETURN br.class.Image[br, set, dir]};
Mapping: PROC [br: BiRel, v: Value, dir: Direction ← leftToRight] RETURNS [Set]
The image of a singleton.
~ INLINE {RETURN br.class.Image[br, Sets.CreateSingleton[v, br.Spaces[][Source[dir]]], dir]};
MappingA: PROC [br: BiRel, v: REF ANY, dir: Direction ← leftToRight] RETURNS [Set]
~ INLINE {RETURN br.class.Image[br, Sets.CreateSingleton[AV[v], br.Spaces[][Source[dir]]], dir]};
MappingI: PROC [br: BiRel, v: INT, dir: Direction ← leftToRight] RETURNS [Set]
~ INLINE {RETURN br.class.Image[br, Sets.CreateSingleton[IV[v], br.Spaces[][Source[dir]]], dir]};
Enumerate: PROC [br: BiRel, Consume: PROC [Pair], ro: RelOrder ← []];
The enumeration order respects the ordering specified by the ro argument relative to the BiRel's spaces. That is, if ro says p1 < p2, then p1 is enumerated before p2; if ro says p1 = p2, they may be enumerated in either order.
EnumAA: PROC [br: BiRel, Consume: PROC [REF ANY, REF ANY], ro: RelOrder ← []];
EnumIA: PROC [br: BiRel, Consume: PROC [INT, REF ANY], ro: RelOrder ← []];
EnumII: PROC [br: BiRel, Consume: PROC [INT, INT], ro: RelOrder ← []];
Tester: TYPE ~ PROC [Pair] RETURNS [BOOL];
AcceptAny: Tester--={RETURN[TRUE]}--;
Scan: PROC [br: BiRel, Test: Tester, ro: RelOrder ← []] RETURNS [MaybePair]
~ INLINE {RETURN br.class.ScanRestriction[br, [], Test, ro]};
EnumerateImage: PROC [br: BiRel, set: Set, Consume: PROC [Value], dir: Direction ← leftToRight, ro: Sets.RelOrder ← no];
EnumerateMapping: PROC [br: BiRel, v: Value, Consume: PROC [Value], dir: Direction ← leftToRight, ro: Sets.RelOrder ← no]
~ INLINE {EnumerateImage[br, Sets.CreateSingleton[v, br.Spaces[][Source[dir]]], Consume, dir, ro]};
EnumerateHalfRestriction: PROC [br: BiRel, set: Set, Consume: PROC [Pair], side: Side ← left, ro: RelOrder ← []];
Enumerates those pairs such that pair[side] is in set.
ScanImage: PROC [br: BiRel, set: Set, Test: Sets.Tester, dir: Direction ← leftToRight, ro: Sets.RelOrder ← no] RETURNS [MaybePair];
ScanMapping: PROC [br: BiRel, v: Value, Test: Sets.Tester, dir: Direction ← leftToRight, ro: Sets.RelOrder ← no] RETURNS [MaybePair]
~ INLINE {RETURN ScanImage[br, Sets.CreateSingleton[v, br.Spaces[][Source[dir]]], Test, dir, ro]};
ScanRestriction: PROC [br: BiRel, sets: SetPair ← [], Test: Tester, ro: RelOrder ← []] RETURNS [MaybePair]
If one of the restricting sets is nilSet, that means don't restrict.
~ INLINE {RETURN br.class.ScanRestriction[br, sets, Test, ro]};
ScanHalfRestriction: PROC [br: BiRel, set: Set, Test: Tester, side: Side ← left, ro: RelOrder ← []] RETURNS [MaybePair]
~ INLINE {RETURN br.class.ScanRestriction[br, ConsSets[side, set], Test, ro]};
ParallelScan: PROC [a, b: BiRel, Test: ParallelTester, roA, roB: RelOrder ← []] RETURNS [ParallelFind]
~ INLINE {RETURN ParallelScanRestriction[a, b, Test, [], [], roA, roB]};
ParallelScanRestriction: PROC [a, b: BiRel, Test: ParallelTester, setsA, setsB: SetPair ← [], roA, roB: RelOrder ← []] RETURNS [ParallelFind];
ParallelTester: TYPE ~ PROC [a, b: MaybePair] RETURNS [pass: BOOLFALSE];
ParallelFind: TYPE ~ RECORD [found: BOOL, a, b: MaybePair];
InterleavedProduceRestriction: PROC [a, b: BiRel, Consume: InterleavedConsumer, setsA, setsB: SetPair ← [], roA, roB: RelOrder ← []] RETURNS [MaybePair];
InterleavedConsumer: TYPE ~ PROC [PROC [Which] RETURNS [MaybePair]] RETURNS [MaybePair];
GetOne: PROC [br: BiRel, remove: BOOL, ro: RelOrder] RETURNS [MaybePair]
~ INLINE {RETURN br.class.GetOne[br, remove, ro]};
APair: PROC [br: BiRel, ro: RelOrder ← []] RETURNS [MaybePair]
~ INLINE {RETURN br.class.GetOne[br, FALSE, ro]};
Pop: PROC [br: BiRel, ro: RelOrder ← []] RETURNS [MaybePair]
~ INLINE {RETURN br.class.GetOne[br, TRUE, ro]};
First: PROC [br: BiRel] RETURNS [MaybePair]
~ INLINE {RETURN br.class.GetOne[br, FALSE, [ALL[fwd]]]};
Last: PROC [br: BiRel] RETURNS [MaybePair]
~ INLINE {RETURN br.class.GetOne[br, FALSE, [ALL[bwd]]]};
Next: PROC [br: BiRel, pair: Pair, ro: RelOrder ← [[fwd, no]]] RETURNS [MaybePair]
~ INLINE {RETURN [br.class.Get3[br, pair, ro, [FALSE, FALSE, TRUE]].next]};
Prev: PROC [br: BiRel, pair: Pair, ro: RelOrder ← [[fwd, no]]] RETURNS [MaybePair]
~ INLINE {RETURN [br.class.Get3[br, pair, ro, [TRUE, FALSE, FALSE]].prev]};
Get3: PROC [br: BiRel, pair: Pair, ro: RelOrder ← [[fwd, no]], want: TripleBool ← []] RETURNS [TripleMaybePair]
~ INLINE {RETURN br.class.Get3[br, pair, ro, want]};
SkipTo: PROC [br: BiRel, goal: Set, bounds: Interval ← fullInterval, side: Side ← left, bwd: BOOLFALSE] RETURNS [MaybePair]
result is (if bwd then greatest else least) solution in bounds to: br[i]=v AND goal.HasMember[v]; if no such solution, result.found=FALSE and result.it is unrestricted.
~ INLINE {RETURN br.ScanRestriction[ConsSets[side, IntervalAsSet[br.Spaces[][side], bounds], goal], AcceptAny, ConsRelOrder[side, IF bwd THEN bwd ELSE fwd]]};
Lookup: PROC [br: BiRel, goal: Value, bounds: Interval ← fullInterval, side: Side ← left, bwd: BOOLFALSE] RETURNS [MaybeValue]
~ INLINE {RETURN br.SkipTo[Sets.CreateSingleton[goal, br.Spaces[][side]], bounds, side, bwd].KeepHalf[OtherSide[side]]};
Size: PROC [br: BiRel, limit: EINT ← lastEINT] RETURNS [EINT]
~ INLINE {RETURN [br.class.RestrictionSize[br, [], limit]]};
Empty: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [br.Size[one]=zero]};
RestrictionSize: PROC [br: BiRel, sets: SetPair ← [], limit: EINT ← lastEINT] RETURNS [EINT]
~ INLINE {RETURN br.class.RestrictionSize[br, sets, limit]};
ImageSize: PROC [br: BiRel, set: Set, dir: Direction ← leftToRight, limit: EINT ← lastEINT] RETURNS [EINT];
MappingSize: PROC [br: BiRel, v: Value, dir: Direction ← leftToRight, limit: EINT ← lastEINT] RETURNS [EINT]
~ INLINE {RETURN ImageSize[br, Sets.CreateSingleton[v, br.Spaces[][Source[dir]]], dir, limit]};
MappingEmpty: PROC [br: BiRel, v: Value, dir: Direction ← leftToRight] RETURNS [BOOL]
~ INLINE {RETURN [MappingSize[br, v, dir, one]=zero]};
IsDense: PROC [br: BiRel, when: When ← always, side: Side ← left] RETURNS [BOOL]
Implies br.SetOn[side].IsDense, now or forever, as requested.
~ INLINE {RETURN br.class.IsDense[br, when, side]};
denseSide: READONLY ROPE; --complaint raised when a caller tries an operation that would put a hole in a necessarily dense side of a BiRel.
SideFixed: PROC [br: BiRel, side: Side ← left] RETURNS [BOOL]
SideFixed[br, side] => br.SetOn[side] won't change.
~ INLINE {RETURN br.class.SideFixed[br, side]};
fixedSide: READONLY ROPE; --complaint raised when a caller tries an operation that would change a fixed side of a BiRel.
GetBounds: PROC [br: BiRel, want: EndBools ← [], ro: RelOrder ← [[fwd, no]]] RETURNS [MaybePairInterval]
~ INLINE {RETURN br.class.GetBounds[br, want, ro]};
MutabilityOf: PROC [br: BiRel] RETURNS [Mutability]
~ INLINE {RETURN [br.class.mutability]};
Copy: PROC [br: BiRel] RETURNS [VarBiRel]
~ INLINE {RETURN br.class.Copy[br]};
Insulate: PROC [br: BiRel] RETURNS [UWBiRel]
~ INLINE {RETURN br.class.Insulate[br]};
ValueOf: PROC [br: BiRel] RETURNS [ConstBiRel]
~ INLINE {RETURN br.class.ValueOf[br]};
Freeze: PROC [br: BiRel] RETURNS [ConstBiRel]
~ INLINE {RETURN br.class.Freeze[br]};
Thaw: PROC [br: BiRel]
~ INLINE {br.class.Thaw[br]};
Has: PROC [br, other: BiRel, want: BoolPair] RETURNS [HadSetPair];
AddPair: PROC [br: BiRel, pair: Pair, if: IfHadPair ← alwaysAdd] RETURNS [had: HadPair]
May also cause deletions in order to preserve functionality.
~ INLINE {RETURN br.class.AddPair[br, pair, if]};
AddAA: PROC [br: BiRel, left, right: REF ANY, if: IfHadPair ← alwaysAdd] RETURNS [had: HadPair];
AddIA: PROC [br: BiRel, left: INT, right: REF ANY, if: IfHadPair ← alwaysAdd] RETURNS [had: HadPair];
AddII: PROC [br: BiRel, left, right: INT, if: IfHadPair ← alwaysAdd] RETURNS [had: HadPair];
AddNewPair: PROC [br: BiRel, pair: Pair];
Like AddPair, with the expectation that the pair is new.
AddNewAA: PROC [br: BiRel, left, right: REF ANY];
AddNewIA: PROC [br: BiRel, left: INT, right: REF ANY];
AddNewII: PROC [br: BiRel, left, right: INT];
AddSet: PROC [br, other: BiRel, if: IfHadPair ← alwaysAdd] RETURNS [some: HadSetPair]
Equivalent to a series of AddPairs. some[n][dir] iff some AddPair[..][dir]=n.
~ INLINE {RETURN br.class.AddSet[br, other, if]};
AddNewSet: PROC [br, other: BiRel];
Same as AddSet[if: addIfNew], and then in functional directions d insist that some[d][same] = some[d][different] = FALSE.
Swap: PROC [br: BiRel, a, b: Value, side: Side ← left]
side=left => br after HasPair[[a, v]] iff br before HasPair[[b, v]], and so on.
~ INLINE {br.class.Swap[br, a, b, side]};
RemPair: PROC [br: BiRel, pair: Pair] RETURNS [had: HadPair]
~ INLINE {RETURN br.class.RemPair[br, pair]};
RemAA: PROC [br: BiRel, left, right: REF ANY] RETURNS [had: HadPair];
RemIA: PROC [br: BiRel, left: INT, right: REF ANY] RETURNS [had: HadPair];
RemII: PROC [br: BiRel, left, right: INT] RETURNS [had: HadPair];
RemSet: PROC [br, other: BiRel] RETURNS [some: HadSetPair]
Equivalent to a bunch of RemPairs.
~ INLINE {RETURN br.class.RemSet[br, other]};
Erase: PROC [br: BiRel]
~ INLINE {[] ← br.RemSet[br]};
Delete: PROC [br: BiRel, val: Value, side: Side ← left] RETURNS [hadSome: BOOL]
Remove pair(s) with equivalent values on the given side. hadSome tells whether there were any.
~ INLINE {RETURN br.class.Delete[br, val, side]};
DeleteA: PROC [br: BiRel, val: REF ANY, side: Side ← left] RETURNS [hadSome: BOOL]
~ INLINE {RETURN br.class.Delete[br, AV[val], side]};
DeleteI: PROC [br: BiRel, val: INT, side: Side ← left] RETURNS [hadSome: BOOL]
~ INLINE {RETURN br.class.Delete[br, IV[val], side]};
DeleteSet: PROC [br: BiRel, set: Set, side: Side ← left] RETURNS [had: SomeAll]
~ INLINE {RETURN br.class.DeleteSet[br, set, side]};
Spaces: PROC [br: BiRel] RETURNS [SpacePair]
Every BiRel knows its spaces.
~ INLINE {RETURN br.class.Spaces[br]};
SetOn: PROC [br: BiRel, side: Side] RETURNS [UWSet]
Returns a collection of the elements on the given side of the pairs of br. Result tracks changes to br.
~ INLINE {RETURN [br.class.SetOn[br, side]]};
CurSetOn: PROC [br: BiRel, side: Side] RETURNS [ConstSet]
Returns the current value, and thus does not track changes to br.
~ INLINE {RETURN br.class.CurSetOn[br, side]};
Functional: PROC [br: BiRel] RETURNS [BoolPair]
Functional[br][leftToRight] => br can't have two pairs with equivalent left Values and non-equivalent right Values.
~ INLINE {RETURN [br.class.functional]};
Equal: PROC [a, b: BiRel, bounds: SetPair ← []] RETURNS [BOOL];
x in bounds[left], y in bounds[right] : <x,y> in a { <x,y> in b.
Hash: PROC [br: BiRel, bounds: SetPair ← []] RETURNS [CARDINAL];
Compare: PROC [a, b: BiRel, bounds: SetPair ← [], tro: TotalRelOrder ← [ALL[fwd]]] RETURNS [Comparison];
CreateBiRelSpace: PROC [eltSpaces: SpacePair] RETURNS [Space];
QuaBiRelSpace: PROC [Space] RETURNS [found: BOOL, eltSpaces: SpacePair];
More Special Cases of Sets
SetIsBiRel: PROC [set: Set] RETURNS [BOOL]
~ INLINE {RETURN [set.class.QuaBiRel[set].found]};
SetAsBiRel: PROC [set: Set] RETURNS [BiRel]
~ INLINE {RETURN [SetQuaBiRel[set].it]};
SetQuaBiRel: PROC [set: Set] RETURNS [MaybeBiRel]
~ INLINE {
found: BOOL;
class, data: REF ANY;
[found, class, data] ← set.class.QuaBiRel[set];
RETURN [IF found THEN [TRUE, [NARROW[class], data]] ELSE [FALSE, badBiRel]]};
Special Cases of BiRels
VarBiRel: TYPE ~ RECORD [BiRel] --a variable BiRel--;
IsVar: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [br.class.mutability=variable]};
AsVar: PROC [br: BiRel] RETURNS [VarBiRel]
~ INLINE {IF br#nilBiRel AND br.class.mutability#variable THEN Complain[br, notVariable]; RETURN [[br]]};
UWBiRel: TYPE ~ RECORD [BiRel] --an unwritable BiRel--;
IsUW: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [br.class.mutability#variable]};
AsUW: PROC [br: BiRel] RETURNS [UWBiRel]
~ INLINE {IF br#nilBiRel AND br.class.mutability=variable THEN Complain[br, writeable]; RETURN [[br]]};
ConstBiRel: TYPE ~ RECORD [UWBiRel] --a constant BiRel--;
IsConst: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [br.class.mutability=constant]};
AsConst: PROC [br: BiRel] RETURNS [ConstBiRel]
~ INLINE {IF br#nilBiRel AND br.class.mutability#constant THEN Complain[br, notConstant]; RETURN [[[br]]]};
Function: TYPE ~ BiRel --a BiRel that doesn't have two pairs with equal left sides--;
VarFunction: TYPE ~ VarBiRel;
UWFunction: TYPE ~ UWBiRel;
ConstFunction: TYPE ~ ConstBiRel;
IsFunction: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [br.class.functional[leftToRight]]};
AsFunction: PROC [br: BiRel] RETURNS [Function]
~ INLINE {IF NOT br.class.functional[leftToRight] THEN br.Complain[narrowFault]; RETURN [br]};
InvFunction: TYPE ~ BiRel --a BiRel that doesn't have two pairs with equal right sides--;
IsInvFunction: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [br.class.functional[rightToLeft]]};
AsInvFunction: PROC [br: BiRel] RETURNS [InvFunction]
~ INLINE {IF NOT br.class.functional[rightToLeft] THEN br.Complain[narrowFault]; RETURN [br]};
OneToOne: TYPE ~ BiRel --a one-to-one BiRel--;
VarOneToOne: TYPE ~ VarBiRel;
ConstOneToOne: TYPE ~ ConstBiRel;
IsOneToOne: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [br.class.functional=ALL[TRUE]]};
AsOneToOne: PROC [br: BiRel] RETURNS [OneToOne]
~ INLINE {IF NOT br.class.functional=ALL[TRUE] THEN br.Complain[narrowFault]; RETURN [br]};
Apply: PROC [br: BiRel, v: Value, dir: Direction ← leftToRight] RETURNS [MaybeValue]
Error raised if mapping bigger than 1. Returns noMaybe if mapping empty.
~ INLINE {RETURN br.class.Apply[br, v, dir]};
mappingNotSingleton: READONLY ROPE;
ApplyA: PROC [br: BiRel, v: REF ANY, dir: Direction ← leftToRight] RETURNS [MaybeValue]
~ INLINE {RETURN br.class.Apply[br, AV[v], dir]};
ApplyI: PROC [br: BiRel, v: INT, dir: Direction ← leftToRight] RETURNS [MaybeValue]
~ INLINE {RETURN br.class.Apply[br, IV[v], dir]};
IntRel: TYPE ~ BiRel --where left side may only contain integers--;
IsIntRel: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [QuaIntRel[br].found]};
AsIntRel: PROC [br: BiRel] RETURNS [IntRel]
~ INLINE {RETURN [QuaIntRel[br].it]};
QuaIntRel: PROC [br: BiRel] RETURNS [MaybeBiRel];
GetIntDom: PROC [br: BiRel, want: EndBools ← []] RETURNS [IntInterval];
ShiftAndClipMe: PROC [br: IntRel, shift: EINT ← zero, clip: IntInterval ← []]
new[i+shift, v] iff (old[i, v] AND i in clip AND i+shift in []).
~ INLINE {br.class.ShiftAndClipMe[br, shift, clip]};
Index: PROC [br, goal: IntRel, bounds: IntInterval ← [], bwd: BOOLFALSE] RETURNS [MaybeValue]
result is (if bwd then greatest else least) solution in bounds to: Equal[Shift[br, -result.i], goal, goal.bounds] (or, equivelently, Equal[br, Shift[goal, result.i], Shift[goal.bounds, result.i]]); if no such solution, result.found=FALSE and result.val is unrestricted.
~ INLINE {RETURN br.class.Index[br, goal, bounds, bwd]};
ReplaceMe: PROC [br, with: IntRel, where: IntInterval]
Let clip=with.GetIntDom in:
new[i, v] iff
old[i, v] & i < where.min, or
with[i-where.min+clip.min, v] & where.min <= i < where.min+clip.Length, or
old[i-clip.Length+where.Length, v] & where.min+clip.Length <= i.
Only current value of with is used.
~ INLINE {br.class.ReplaceMe[br, with, where]};
Insert: PROC [br: IntRel, val: Value, before: INT]
~ INLINE {[] ← ReplaceMe[br, CreateSingleton[[[i: 0], val], br.Spaces], [before, before-1]]};
Append: PROC [br: IntRel, val: Value]
~ INLINE {Insert[br, val, br.GetIntDom.max+1]};
AppendA: PROC [br: IntRel, val: REF ANY]
~ INLINE {Insert[br, AV[val], br.GetIntDom.max+1]};
AppendI: PROC [br: IntRel, val: INT]
~ INLINE {Insert[br, IV[val], br.GetIntDom.max+1]};
IntFn: TYPE ~ IntRel --that is Functional[leftToRight]--;
ConstIntFn: TYPE ~ ConstBiRel;
IsIntFn: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [QuaIntFn[br].found]};
AsIntFn: PROC [br: BiRel] RETURNS [IntFn]
~ INLINE {RETURN [QuaIntFn[br].it]};
QuaIntFn: PROC [br: BiRel] RETURNS [MaybeBiRel];
Array: TYPE ~ IntFn --whose domain is an interval--;
IsArray: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [IsIntFn[br] AND br.IsDense[now, left]]};
AsArray: PROC [br: BiRel] RETURNS [Array]
~ INLINE {IF NOT (IsIntFn[br] AND br.IsDense[now, left]) THEN br.Complain[narrowFault]; RETURN [br]};
FixedArray: TYPE ~ Array --whose domain will never change--;
IsFixedArray: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [IsIntFn[br] AND br.IsDense[always, left] AND br.SideFixed[left]]};
AsFixdArray: PROC [br: BiRel] RETURNS [FixedArray]
~ INLINE {IF NOT IsFixedArray[br] THEN br.Complain[narrowFault]; RETURN [br]};
Sequence: TYPE ~ Array --whose lower bound is 0--;
IsSequence: PROC [br: BiRel] RETURNS [BOOL]
~ INLINE {RETURN [br.IsArray AND br.GetIntDom[].min=0]};
Automorphism: TYPE ~ BiRel--that's one-to-one, and domain = range--;
Permutation: TYPE ~ Sequence--that's an Automorphism--;
GradeUp: PROC [a: IntFn, o: SetBasics.Order] RETURNS [p: Permutation];
i < j Ò a[p[i]] d a[p[j]].
TransPermute: PROC [from: IntFn, to: Sequence, p: Permutation];
for each [new, old] in p: to[new] ← from[old].
PermuteInPlace: PROC [a: Sequence, p: Permutation];
Some Implementations of BiRels
CreateEmptyBiRel: PROC [SpacePair] RETURNS [ConstBiRel];
CreateIDSubset: PROC [Set] RETURNS [BiRel];
IsIDSubset: PROC [BiRel] RETURNS [BOOL];
CreateFullIDSubset: PROC [s: Space] RETURNS [ConstOneToOne]
~ INLINE {RETURN [CreateIDSubset[CreateFullSet[s]].AsConst]};
CreateAllPairs: PROC [SpacePair] RETURNS [ConstOneToOne];
CreateSingleton: PROC [elt: Pair, spaces: SpacePair] RETURNS [ConstBiRel]
~ INLINE {RETURN [[[[GetSingletonClass[spaces], NEW [Pair ← elt]]]]]};
GetSingletonClass: PROC [spaces: SpacePair] RETURNS [BiRelClass];
NCreateSingleton: PROC [elt: Pair, spaces: SpacePair] RETURNS [ConstBiRel];
CreateConstant: PROC [bounds: Interval, val: Value, spaces: SpacePair ← [ints, refs]] RETURNS [ConstIntFn]
~ INLINE {RETURN CreateProduct[[IntervalAsSet[spaces[left], bounds], Sets.CreateSingleton[val, spaces[right]]]].AsConst};
CreateProduct: PROC [SetPair] RETURNS [BiRel];
FnFromProc: PROC
[
Apply: PROC [data: REF ANY, v: Value] RETURNS [mv: MaybeValue],
spaces: SpacePair ← [refs, refs],
data: REF ANYNIL,
constant, oneToOne: BOOLFALSE,
ScanInverse: PROC [data: REF ANY, v: Value, Test: Tester] RETURNS [MaybePair] ← NIL
]
RETURNS [Function];
CreateSimple: PROC [bounds: IntInterval ← [0, -1], val: Value ← noValue, oneToOne, dense, domainFixed: BOOLFALSE, rightSpace: Space ← refs] RETURNS [IntFn];
CreateSimpleCopy: PROC [of: IntFn, bounds: IntInterval ← [], oneToOne, dense, domainFixed: RelBool ← SAME, rightSpace: Space ← NIL] RETURNS [IntFn];
Like CreateSimple, but the function is initialized from the given one, subject to the given bounds. Giving rightSpace=NIL means to use the original's.
CreateList: PROC [vals: LOP, functional: BoolPair ← [FALSE, FALSE], spaces: SpacePair ← [refs, refs], mutability: Mutability ← variable, order: RelOrder ← [], assumeSorted: BOOLFALSE] RETURNS [VarBiRel];
HashFn: TYPE ~ VarFunction;
CreateHashReln: PROC [spaces: SpacePair ← [refs, refs], functional: BoolPair ← [FALSE, FALSE], mappable: BoolPair ← [TRUE, TRUE]] RETURNS [VarBiRel];
(functional[dir] OR mappable[dir]) tells whether the result can Image in direction dir.
CreateHashOTO: PROC [spaces: SpacePair ← [refs, refs]] RETURNS [VarOneToOne]
~ INLINE {RETURN CreateHashReln[spaces, ALL[TRUE]]};
CreateHashFn: PROC [spaces: SpacePair ← [refs, refs], invable: BOOLTRUE] RETURNS [HashFn]
~ INLINE {RETURN CreateHashReln[spaces, [TRUE, FALSE], [TRUE, invable]]};
CreateHashTable: PROC [right: Space ← refs, invable: BOOLTRUE] RETURNS [HashFn]
~ INLINE {RETURN CreateHashReln[[refs, right], [TRUE, FALSE], [TRUE, invable]]};
CreateHashDictionary: PROC [case: BOOLTRUE, right: Space ← refs, invable: BOOLTRUE] RETURNS [HashFn]
~ INLINE {RETURN CreateHashReln[[ropes[case], right], [TRUE, FALSE], [TRUE, invable]]};
CreateHashCopy: PROC [br: BiRel, spaces: SpacePair ← [NIL, NIL], mappable: BoolPair ← [FALSE, FALSE]] RETURNS [HashFn];
NIL space means use the same space as the given BiRel. Can map in direction d iff mappable[d] OR functional[d].
The following use a standard implementation. The result tracks changes to the arguments, if any. Result may duplicate iff any argument may.
Union: PROC [a, b: BiRel, disjoint: BOOLFALSE, ro: RelOrder ← []] RETURNS [UWBiRel];
Intersection: PROC [BiRel, BiRel] RETURNS [UWBiRel];
Difference: PROC [BiRel, BiRel] RETURNS [UWBiRel];
SymmetricDifference: PROC [a, b: BiRel] RETURNS [c: UWBiRel];
Negate: PROC [BiRel] RETURNS [BiRel];
Compose: PROC [left, right: BiRel, restricts: ARRAY Side OF BOOL ← [TRUE, TRUE]] RETURNS [BiRel];
restricts[left]=FALSE means caller is guaranteeing that henceforth SetOn[right, left] is included in SetOn[left, right].
Invert: PROC [BiRel] RETURNS [BiRel];
Collect: PROC [u: BiRel, side: Side ← right] RETURNS [c: Function];
When side=right, c[l, {r | u[l, r]}] OR MappingSize[c, l]=0 AND MappingSize[u, l]=0.
UnCollect: PROC [c: Function, side: Side ← right] RETURNS [u: BiRel];
When side=right, c is function yielding sets, and u[l, r] iff r in c[l].
Replace: PROC [br, with: IntRel, where: IntInterval] RETURNS [IntRel];
ShiftAndClip: PROC [br: IntRel, shift: EINT ← zero, clip: IntInterval ← []] RETURNS [IntRel];
result[i+shift, v] iff (br[i, v] AND i in clip AND i+shift in []).
CreateShiftAndClipper: PROC [shift: EINT ← zero, clip: IntInterval ← []] RETURNS [ConstOneToOne];
Result has pair [i, i+shift] when i IN clip AND i+shift IN [INT.FIRST..INT.LAST].
Shift: PROC [br: IntRel, shift: EINT] RETURNS [IntRel]
result[i+shift, v] iff br[i, v].
~ INLINE {RETURN ShiftAndClip[br, shift]};
Subseq: PROC [br: IntRel, bounds: IntInterval] RETURNS [IntRel]
~ INLINE {RETURN ShiftAndClip[br, IE[bounds.min].Neg, bounds]};
ImplementSetBySequence: PROC [seq: Sequence, addat: SeqAddPlace, closeGaps: BOOL] RETURNS [Set];
SeqAddPlace: TYPE ~ {front, back};
ImplementSetByIDSubset: PROC [ids: OneToOne] RETURNS [Set];
EnumSeqOfSet: PROC [set: Set, ro: Sets.RelOrder ← no] RETURNS [Sequence];
ith element of result is ith element enumerated by set.
Implementing BiRels
BiRelClass: TYPE ~ REF BiRelClassPrivate;
BiRelClassPrivate: TYPE ~ MONITORED RECORD [
Primitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANYNIL] RETURNS [PrimitiveAnswer] ← NIL,
AsSet: PROC [br: BiRel, ro: RelOrder] RETURNS [Set--of REF Pair--] ← NIL,
HasPair: PROC [br: BiRel, pair: Pair] RETURNS [BOOL] ← NIL,
Image: PROC [br: BiRel, set: Set, dir: Direction] RETURNS [Set] ← NIL,
Apply: PROC [br: BiRel, v: Value, dir: Direction] RETURNS [MaybeValue] ← NIL,
ScanRestriction: PROC [br: BiRel, sets: SetPair, Test: Tester, ro: RelOrder] RETURNS [MaybePair] ← NIL,
GetOne: PROC [br: BiRel, remove: BOOL, ro: RelOrder] RETURNS [MaybePair] ← NIL,
Get3: PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool] RETURNS [TripleMaybePair] ← NIL,
Index: PROC [br, goal: IntRel, bounds: IntInterval, bwd: BOOL] RETURNS [MaybeValue] ← NIL,
RestrictionSize: PROC [br: BiRel, sets: SetPair, limit: EINT] RETURNS [EINT] ← NIL,
GetBounds: PROC [br: BiRel, want: EndBools, ro: RelOrder] RETURNS [MaybePairInterval] ← NIL,
Copy: PROC [br: BiRel] RETURNS [VarBiRel] ← NIL,
Insulate: PROC [br: BiRel] RETURNS [UWBiRel] ← NIL,
ValueOf: PROC [br: BiRel] RETURNS [ConstBiRel] ← NIL,
Freeze: PROC [br: BiRel] RETURNS [ConstBiRel] ← NIL,
Thaw: PROC [br: BiRel] ← NIL,
SetOn: PROC [br: BiRel, side: Side] RETURNS [UWSet] ← NIL,
CurSetOn: PROC [br: BiRel, side: Side] RETURNS [ConstSet] ← NIL,
AddPair: PROC [br: BiRel, pair: Pair, if: IfHadPair] RETURNS [had: HadPair] ← NIL,
AddSet: PROC [br, other: BiRel, if: IfHadPair] RETURNS [some: HadSetPair] ← NIL,
Swap: PROC [br: BiRel, a, b: Value, side: Side] ← NIL,
RemPair: PROC [br: BiRel, pair: Pair] RETURNS [had: HadPair] ← NIL,
RemSet: PROC [br, other: BiRel] RETURNS [some: HadSetPair] ← NIL,
Delete: PROC [br: BiRel, val: Value, side: Side] RETURNS [hadSome: BOOL] ← NIL,
DeleteSet: PROC [br: BiRel, set: Set, side: Side] RETURNS [had: SomeAll] ← NIL,
ReplaceMe: PROC [br, with: IntRel, where: IntInterval] ← NIL,
ShiftAndClipMe: PROC [br: BiRel, shift: EINT, clip: IntInterval] ← NIL,
Spaces: PROC [br: BiRel] RETURNS [SpacePair] ←,
IsDense: PROC [br: BiRel, when: When, side: Side] RETURNS [BOOL] ← NIL,
SideFixed: PROC [br: BiRel, side: Side] RETURNS [BOOL] ← NIL,
functional: BoolPair ← [FALSE, FALSE],
mutability: Mutability ← variable,
other: Atom.PropList ← NIL, --the canonical expansion slot
data: REF ANYNIL
];
The only part that may vary is the other, and that must be accessed through the update procedure below.
CreateClass: PROC [cp: BiRelClassPrivate, dirable: BoolPair ← [TRUE, FALSE]] RETURNS [BiRelClass];
NIL procs mean the implementor declines to implement the proc; NIL fields get filled in with default procedures that compute with provided fields. Iff Primitive is elided, `bkwdable' and `dirable' are taken into consideration when constructing Primitive.
DefaultAsSet: PROC [br: BiRel, ro: RelOrder] RETURNS [Set--of REF Pair--];
DefaultHasPair: PROC [br: BiRel, pair: Pair] RETURNS [BOOL];
DefaultImage: PROC [br: BiRel, set: Set, dir: Direction] RETURNS [Set];
DefaultApply: PROC [br: BiRel, v: Value, dir: Direction] RETURNS [MaybeValue];
DefaultScanRestriction: PROC [br: BiRel, sets: SetPair, Test: Tester, ro: RelOrder] RETURNS [MaybePair];
DefaultGetOne: PROC [br: BiRel, remove: BOOL, ro: RelOrder] RETURNS [MaybePair];
DefaultGet3: PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool] RETURNS [TripleMaybePair];
DefaultIndex: PROC [br, goal: IntRel, bounds: IntInterval, bwd: BOOL] RETURNS [MaybeValue];
DefaultRestrictionSize: PROC [br: BiRel, sets: SetPair, limit: EINT] RETURNS [EINT];
DefaultGetBounds: PROC [br: BiRel, want: EndBools, ro: RelOrder] RETURNS [MaybePairInterval];
DefaultCopy: PROC [br: BiRel] RETURNS [VarBiRel];
DefaultInsulate: PROC [br: BiRel] RETURNS [UWBiRel];
DefaultValueOf: PROC [br: BiRel] RETURNS [ConstBiRel];
DefaultFreeze: PROC [br: BiRel] RETURNS [ConstBiRel];
DefaultThaw: PROC [br: BiRel];
DefaultSetOn: PROC [br: BiRel, side: Side] RETURNS [UWSet];
DefaultCurSetOn: PROC [br: BiRel, side: Side] RETURNS [ConstSet];
DefaultAddPair: PROC [br: BiRel, pair: Pair, if: IfHadPair] RETURNS [had: HadPair];
DefaultAddSet: PROC [br, other: BiRel, if: IfHadPair] RETURNS [some: HadSetPair];
DefaultSwap: PROC [br: BiRel, a, b: Value, side: Side];
DefaultRemPair: PROC [br: BiRel, pair: Pair] RETURNS [had: HadPair];
DefaultRemSet: PROC [br, other: BiRel] RETURNS [some: HadSetPair];
DefaultDelete: PROC [br: BiRel, val: Value, side: Side] RETURNS [hadSome: BOOL];
DefaultDeleteSet: PROC [br: BiRel, set: Set, side: Side] RETURNS [had: SomeAll];
DefaultReplaceMe: PROC [br, with: IntRel, where: IntInterval];
DefaultShiftAndClipMe: PROC [br: BiRel, shift: EINT, clip: IntInterval];
DefaultIsDense: PROC [br: BiRel, when: When, side: Side] RETURNS [BOOL];
DefaultSideFixed: PROC [br: BiRel, side: Side] RETURNS [BOOL];
UpdateBiRelClassOther: PROC [class: BiRelClass, Update: PROC [Atom.PropList] RETURNS [Atom.PropList]];
Asking About a BiRel's Implementation
QualityOf: PROC [br: BiRel, op: ATOM, arg1, arg2, arg3, arg4: REF ANYNIL] RETURNS [ImplQuality];
Use this to investigate what operations a BiRel supports, and how well it does so. The quality depends on the BiRel, the operation, and certain arguments. Those arguments are indicated to QualityOf as arg1, arg2, and so on. An enumerated value is passed by an ATOM whose name is the name of the value; a RelOrder is passed by a coding indicated below; an other non-ref kind of value is passed as a REF to itself. The op is the name of a procedure in this interface (other than QualityOf and derivatives) that calls class procedures.
Arguments that are passed are: Sets; BiRels; Directions; Sides; RelOrders; bwd, want*: BOOL; EndBools; Interval; limit: EINT; SetPairs; When.
Arguments not passed are: Values; Pairs; callback procedures; remove: BOOL; IntInterval; IfHadPair.
RefBiRel: TYPE ~ REF BiRel;
RefSetPair: TYPE ~ REF SetPair;
refNilSets: READONLY RefSetPair;
ToSide: PROC [arg: REF ANY, default: Side ← left] RETURNS [Side];
ToDir: PROC [arg: REF ANY, default: Direction ← leftToRight] RETURNS [Direction];
ToBiRel: PROC [arg: REF ANY] RETURNS [RefBiRel];
ToSets: PROC [arg: REF ANY, default: RefSetPair ← refNilSets] RETURNS [RefSetPair];
ToRO: PROC [arg: REF ANY, default: RelOrder ← []] RETURNS [RelOrder];
FromSide: PROC [side: Side] RETURNS [ATOM]
~ INLINE {RETURN [IF side=left THEN $left ELSE $right]};
FromDir: PROC [dir: Direction] RETURNS [ATOM]
~ INLINE {RETURN [IF dir=leftToRight THEN $leftToRight ELSE $rightToLeft]};
FakeSingleton: PROC [sp: SpacePair] RETURNS [ConstBiRel]
~ INLINE {RETURN CreateSingleton[noPair, sp]};
FakeRefSingleton: PROC [sp: SpacePair] RETURNS [RefBiRel]
~ INLINE {RETURN CreateSingleton[noPair, sp].Refify};
FromSets: PROC [sp: SetPair] RETURNS [RefSetPair];
FromRO: PROC [ro: RelOrder] RETURNS [ATOM];
e.g.: FromRO[[[no, Bwd], left]] = $leftNoBwd
Can: PROC [br: BiRel, op: ATOM, arg1, arg2, arg3, arg4: REF ANYNIL] RETURNS [BOOL]
~ INLINE {RETURN [QualityOf[br, op, arg1, arg2, arg3, arg4]#cant]};
GoodImpl: PROC [br: BiRel, op: ATOM, arg1, arg2, arg3, arg4: REF ANYNIL] RETURNS [BOOL]
~ INLINE {RETURN [QualityOf[br, op, arg1, arg2, arg3, arg4]>=goodDefault]};
Primitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANYNIL] RETURNS [BOOL];
Other Random New Stuff
Complain: PROC [br: BiRel, msg: ROPE, args: LOVNIL]
~ INLINE {Error[msg, CONS[AV[br.Refify], args]]};
MaybeBiRel: TYPE ~ RECORD [found: BOOL, it: BiRel];
}.