Some basic stuff
LORA: TYPE ~ LIST OF REF ANY;
LNAT: TYPE ~ INT--[0 .. INT.LAST]--;
EINT: TYPE ~ IntStuff.EINT;
lastEINT: EINT ~ IntStuff.lastEINT;
IntInterval: TYPE ~ IntStuff.Interval;
ROPE: TYPE ~ Rope.ROPE;
LOV: TYPE ~ LIST OF Value;
Error:
ERROR [msg:
ROPE, args:
LOV];
For random objections to calls.
Values
Value:
TYPE ~
RECORD [
SELECT kind: ValueKind
FROM
no => [fill: INT ← 0], --the fill is not meaningful, it's just there to make all the variants have the same length, which makes the compiler a little happier. There should never be a no Value with fill other than 0.
a => [a: REF ANY],
i => [i: INT],
ENDCASE];
ValueKind: TYPE ~ {no, a, i};
NotAValue: TYPE ~ Value[no];
RefAnyValue: TYPE ~ Value[a];
IntValue: TYPE ~ Value[i];
noValue: NotAValue ~ [no[]];
AV:
PROC [a:
REF
ANY]
RETURNS [RefAnyValue]
~ INLINE {RETURN [[a[a]]]};
IV:
PROC [i:
INT]
RETURNS [IntValue]
~ INLINE {RETURN [[i[i]]]};
VA:
PROC [v: Value]
RETURNS [
REF
ANY]
~ TRUSTED INLINE {RETURN [WITH v SELECT FROM a => a, ENDCASE => Error[narrowFault, LIST[v]]]};
VI:
PROC [v: Value]
RETURNS [
INT]
~ TRUSTED INLINE {RETURN [WITH v SELECT FROM i => i, ENDCASE => Error[narrowFault, LIST[v]]]};
narrowFault: READONLY ROPE;
notFound: READONLY ROPE;
MaybeValues
A MaybeValue is a BOOLEAN and a Value; it is the result of a procedure that might return a Value, or might return nothing. We define a TYPE for it for client convencience: Cedar's type conformance rules are such that there's nothing a client can write to which the return record of a procedure can be assigned, so we have to have a TYPE of our own that packages up all the return arguments of a procedure if we want clients to be able to assign the entire results of a procedure call to one variable.
MaybeValue: TYPE ~ RECORD [found: BOOL, it: Value];
noMaybe: MaybeValue ~ [FALSE, noValue];
Val:
PROC [mv: MaybeValue]
RETURNS [Value]
If there's really a Value here, return it; otherwise, Error[notFound].
~ INLINE {RETURN [IF mv.found THEN mv.it ELSE Error[notFound, NIL]]};
DVal:
PROC [mv: MaybeValue, ifNotFound: Value]
RETURNS [Value]
If there's really a Value here return it; otherwise return a given default value.
~ INLINE {RETURN [IF mv.found THEN mv.it ELSE ifNotFound]};
MA:
PROC [mv: MaybeValue]
RETURNS [
REF
ANY]
Val composed with VA.
~ TRUSTED INLINE {RETURN [IF mv.found THEN WITH mv.it SELECT FROM a => a, ENDCASE => Error[narrowFault, LIST[mv.it]] ELSE Error[notFound, NIL]]};
MDA:
PROC [mv: MaybeValue, ifNotFound:
REF
ANY ←
NIL]
RETURNS [
REF
ANY]
~ TRUSTED INLINE {RETURN [IF mv.found THEN WITH mv.it SELECT FROM a => a, ENDCASE => Error[narrowFault, LIST[mv.it]] ELSE ifNotFound]};
MI:
PROC [mv: MaybeValue]
RETURNS [
INT]
~ TRUSTED INLINE {RETURN [IF mv.found THEN WITH mv.it SELECT FROM i => i, ENDCASE => Error[narrowFault, LIST[mv.it]] ELSE Error[notFound, NIL]]};
MDI:
PROC [mv: MaybeValue, ifNotFound:
INT]
RETURNS [
INT]
~ TRUSTED INLINE {RETURN [IF mv.found THEN WITH mv.it SELECT FROM i => i, ENDCASE => Error[narrowFault, LIST[mv.it]] ELSE ifNotFound]};
Spaces
A Space tells how to interpret Values as `value's. Each space implements membership testing (not every Value is in every space), hashing, and a total ordering. Each space also has a name.
Space: TYPE ~ REF SpacePrivate;
basic:
READONLY Space;
treats REF ANY as address, INT as integer.
refs, ints, spaceSpace: READONLY Space;
ropes: READONLY ARRAY --case matters--BOOL OF Space;
SContains:
PROC [s: Space, v: Value]
RETURNS [
BOOL]
~ INLINE {RETURN s.Contains[s.data, v]};
SEqual:
PROC [s: Space, v1, v2: Value]
RETURNS [
BOOL]
~ INLINE {RETURN s.Equal[s.data, v1, v2]};
SHash:
PROC [s: Space, v: Value]
RETURNS [
CARDINAL]
~ INLINE {RETURN s.Hash[s.data, v]};
SCompare:
PROC [s: Space, v1, v2: Value]
RETURNS [Comparison]
~ INLINE {RETURN s.Compare[s.data, v1, v2]};
SMin:
PROC [s: Space, e1, e2: Value]
RETURNS [Value]
~ INLINE {RETURN [IF s.Compare[s.data, e1, e2] <= equal THEN e1 ELSE e2]};
SMax:
PROC [s: Space, e1, e2: Value]
RETURNS [Value]
~ INLINE {RETURN [IF s.Compare[s.data, e1, e2] >= equal THEN e1 ELSE e2]};
Intervals
Interval: TYPE ~ ARRAY End OF NoingValue;
End: TYPE ~ {min, max};
NoingValue:
TYPE ~ Value ← noValue;
Inclusive. An interval is relative to a space. An extremum of noValue means the appropriate extremal value of the space.
IEmpty:
PROC [s: Space, i: Interval]
RETURNS [
BOOL]
~ INLINE {RETURN [i[min]#noValue AND i[max]#noValue AND s.SCompare[i[min], i[max]]=greater]};
IContains:
PROC [s: Space, i: Interval, v: Value]
RETURNS [
BOOL]
~ INLINE {RETURN [(i[min]=noValue OR s.SCompare[i[min], v]<=equal) AND (i[max]=noValue OR s.SCompare[v, i[max]]<=equal)]};
MBI:
PROC [s: Space, i1, i2: Interval]
RETURNS [Interval]
~
INLINE {
RETURN[[
min: IF i1[min]=noValue OR i2[min]=noValue THEN noValue ELSE s.SMin[i1[min], i2[min]],
max: IF i1[max]=noValue OR i2[max]=noValue THEN noValue ELSE s.SMax[i1[max], i2[max]]]]};
IIntersection:
PROC [s: Space, i1, i2: Interval]
RETURNS [Interval]
~
INLINE {
RETURN[[
min: IF i1[min]=noValue THEN i2[min] ELSE IF i2[min]=noValue THEN i1[min] ELSE s.SMax[i1[min], i2[min]],
max: IF i1[max]=noValue THEN i2[max] ELSE IF i2[max]=noValue THEN i1[max] ELSE s.SMin[i1[max], i2[max]]]]};
BoundsOfVals:
PROC [s: Space, v1, v2: Value]
RETURNS [Interval]
~ INLINE {RETURN[IF s.SCompare[v1, v2]<=equal THEN [v1, v2] ELSE [v2, v1]]};
IIntify:
PROC [i: Interval]
RETURNS [IntInterval]
~
INLINE {
RETURN [[
min: IF i[min]=noValue THEN INT.FIRST ELSE i[min].VI,
max: IF i[max]=noValue THEN INT.LAST ELSE i[max].VI]]};
IValify:
PROC [i: IntInterval]
RETURNS [Interval]
~ INLINE {RETURN [[[i[i.min]], [i[i.max]]]]};
Implementing Spaces
SpacePrivate:
TYPE ~
MONITORED
RECORD [
Contains: TestProc,
Equal: EqualProc,
Hash: HashProc,
Compare: CompareProc,
name: ROPE ←,
other: Atom.PropList ← NIL, --the canonical expansion slot
data: REF ANY
];
The only thing that may vary is the other, and that must accessed through the monitor entry procedures below.
TestProc: TYPE ~ PROC [data: REF ANY, v: Value] RETURNS [BOOL];
EqualProc: TYPE ~ PROC [data: REF ANY, v1, v2: Value] RETURNS [BOOL];
HashProc: TYPE ~ PROC [data: REF ANY, v: Value] RETURNS [CARDINAL];
CompareProc: TYPE ~ PROC [data: REF ANY, v1, v2: Value] RETURNS [Comparison];
HashIntI:
PROC [
INT]
RETURNS [
CARDINAL]
~ TRUSTED MACHINE CODE { PrincOps.zXOR };
HashRefI:
PROC [
REF
ANY]
RETURNS [
CARDINAL]
~ TRUSTED MACHINE CODE { PrincOps.zXOR };
CompareIntI:
PROC [a, b:
INT]
RETURNS [Comparison]
~ Basics.CompareInt;
CompareRefI:
PROC [a, b:
REF
ANY]
RETURNS [Comparison]
~ TRUSTED INLINE {RETURN [Basics.CompareInt[LOOPHOLE[a], LOOPHOLE[b]]]};
UpdateSpaceOther: PROC [s: Space, Update: PROC [Atom.PropList] RETURNS [Atom.PropList]];
Ordering
--total--Comparison: TYPE ~ Basics.Comparison;
RevComp: ARRAY Comparison OF Comparison ~ [equal: equal, less: greater, greater: less];
--total--Order:
TYPE ~
RECORD [
Compare: CompareProc,
data: REF ANY];
OCompare:
PROC [o: Order, v1, v2: Value]
RETURNS [Comparison]
~ INLINE {RETURN o.Compare[o.data, v1, v2]};
ReverseOrder:
PROC [o: Order]
RETURNS [ro: Order];
If o says a before b, ro says b before a.
ComposeOrders:
PROC [mso, lso: Order]
RETURNS [Order];
If mso (most significant ordering) doesn't say equal, that's it; otherwise consult lso.
SpaceOrder:
PROC [space: Space]
RETURNS [Order]
~ INLINE {RETURN [[space.Compare, space.data]]};
OrderList: TYPE ~ LIST OF Order;
LexLOV:
PROC [prefix, repeat: OrderList]
RETURNS [Order];
Returns an ordering on LOVs. The first elements are compared with prefix.first; if not equal, that's it. Otherwise the second elements are compared with prefix.rest.first; if not equal, that's it. Otherwise continue, until either prefix or one of the LOVs is exhausted. If one of the LOVs is exhausted, return: equal if the other is, less or greater if the other isn't (dependening on whether the empty one was the first or second argument). If prefix is exhausted before both lists, pick up with repeat. If repeat is exhausted before both lists, use it over again.
LexLORA:
PROC [prefix, repeat: OrderList]
RETURNS [Order];
Like LexLOV, except that the ordering is on LORAs.
PartialComparison: TYPE ~ MACHINE DEPENDENT {less(0), equal(1), greater(2), notrel(3)};
RevPComp: ARRAY PartialComparison OF PartialComparison ~ [less: greater, equal: equal, greater: less, notrel: notrel];
Partialify: ARRAY Comparison OF PartialComparison ~ [less: less, equal: equal, greater: greater];
Totalify: ARRAY PartialComparison[less..greater] OF Comparison ~ [less: less, equal: equal, greater: greater];
RevPartialify: ARRAY Comparison OF PartialComparison ~ [less: greater, equal: equal, greater: less];
Squash: ARRAY PartialComparison OF Comparison ~ [less: less, equal: equal, greater: greater, notrel: equal];
Unrel: ARRAY Comparison OF PartialComparison ~ [less: notrel, equal: equal, greater: notrel];
ParitialCompareProc: TYPE ~ PROC [data: REF ANY, v1, v2: Value] RETURNS [PartialComparison];
PartialCompareIntI:
PROC [a, b:
INT]
RETURNS [PartialComparison]
~ LOOPHOLE[Basics.CompareInt];
PartialCompareRefI:
PROC [a, b:
REF
ANY]
RETURNS [PartialComparison]
~ TRUSTED INLINE {RETURN [PartialCompareIntI[LOOPHOLE[a], LOOPHOLE[b]]]};
Relative Orders
RelOrder:
TYPE ~ {no, fwd, bwd};
An RelOrder specifies a partial ordering among values, relative to the ordering of a space. fwd means the same ordering as the space's; bwd means the reversal of that ordering; no means space-equal values are considered equal, and all other pairs are considered unrelated.
RelPCompare:
PROC [ro: RelOrder, space: Space, v1, v2: Value]
RETURNS [PartialComparison]
~
INLINE {
SELECT ro
FROM
no => RETURN [IF space.SEqual[v1, v2] THEN equal ELSE notrel];
fwd => RETURN [Partialify[space.SCompare[v1, v2]]];
bwd => RETURN [Partialify[space.SCompare[v2, v1]]];
ENDCASE => ERROR};
RelCompare:
PROC [ro: RelOrder, space: Space, v1, v2: Value]
RETURNS [Comparison]
A perversion that considers two unrelated elements to be equal.
~
INLINE {
SELECT ro
FROM
no => RETURN [equal];
fwd => RETURN space.SCompare[v1, v2];
bwd => RETURN space.SCompare[v2, v1];
ENDCASE => ERROR};
RelativizeComparison:
PROC [ro: RelOrder, c: Comparison]
RETURNS [PartialComparison]
~
INLINE {
RETURN [
SELECT ro
FROM
no => Unrel[c],
fwd => Partialify[c],
bwd => RevPartialify[c],
ENDCASE => ERROR]};
ReverseRelOrder: ARRAY RelOrder OF RelOrder ~ [no, bwd, fwd];
ReverseRO:
PROC [ro: RelOrder]
RETURNS [RelOrder]
~ INLINE {RETURN [ReverseRelOrder[ro]]};