[Cyan]<CedarChest7.0>SetsAndStuff>SetBasics.Mesa!8

SetBasics.Mesa

Last tweaked by Mike Spreitzer on March 8, 1988 2:35:26 pm PST

DIRECTORY Atom, Basics, BasicTime, IntStuff, IO, PrincOps, Rope;

SetBasics: CEDAR DEFINITIONS

IMPORTS Basics

= {

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 [ra: REF ANY ← NIL, i: INT ← 0];

What an incredible pain in the neck! This Cedar TYPE will be used to hold the client's Cedar representation for his arbitrary abstraction. We'd like the client to be able to use representations that are REF Somethings, and we'd also like the client to be able to use representations that are 32-bit non-REFs (like INTs, REALs, and GMTs). Because of Cedar's safety rules (wrt the runtime typing for the garbage collector), we can't use a variant record. So we use this record.

noValue: READONLY Value -- = [noRef, INT.FIRST] --;

noRef: READONLY NoRef;

NoRef: TYPE ~ REF NoReferent;

NoReferent: TYPE ~ RECORD [];

We introduce noValue as a Value that means "there's no client representation here". Like NIL among REFs, it is an exceptional value; noValue is used when we don't wish to represent a client abstraction. For the convenience of clients writing WITH .. SELECT statements, we publicize the Cedar TYPE used in the ra field.

The following procedures provide convenience and insulation for clients.

AV: PROC [a: REF ANY] RETURNS [Value]

~ INLINE {RETURN [[ra: a]]};

IV: PROC [i: INT] RETURNS [Value]

~ INLINE {RETURN [[i: i]]};

CV: PROC [c: CARD] RETURNS [Value]

~ INLINE {RETURN [[i: LOOPHOLE[c]]]};

RV: PROC [r: REAL] RETURNS [Value]

~ INLINE {RETURN [[i: LOOPHOLE[r]]]};

TV: PROC [t: BasicTime.GMT] RETURNS [Value]

~ INLINE {RETURN [[i: LOOPHOLE[t]]]};

VA: PROC [v: Value] RETURNS [REF ANY]

~ INLINE {RETURN [v.ra]};

VI: PROC [v: Value] RETURNS [INT]

~ INLINE {RETURN [IF v.ra#noRef THEN v.i ELSE Error[narrowFault, LIST[v]]]};

VC: PROC [v: Value] RETURNS [CARD]

~ INLINE {RETURN [IF v.ra#noRef THEN LOOPHOLE[v.i] ELSE Error[narrowFault, LIST[v]]]};

VR: PROC [v: Value] RETURNS [REAL]

~ INLINE {RETURN [IF v.ra#noRef THEN LOOPHOLE[v.i] ELSE Error[narrowFault, LIST[v]]]};

VT: PROC [v: Value] RETURNS [BasicTime.GMT]

~ INLINE {RETURN [IF v.ra#noRef THEN LOOPHOLE[v.i] ELSE 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: READONLY 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.

~ INLINE {RETURN [IF mv.found THEN mv.it.ra ELSE Error[notFound, NIL]]};

MDA: PROC [mv: MaybeValue, ifNotFound: REF ANY ← NIL] RETURNS [REF ANY]

~ INLINE {RETURN [IF mv.found THEN mv.it.ra ELSE ifNotFound]};

MI: PROC [mv: MaybeValue] RETURNS [INT]

~ INLINE {RETURN [IF mv.found THEN IF mv.it.ra#noRef THEN mv.it.i ELSE Error[narrowFault, LIST[mv.it]] ELSE Error[notFound, NIL]]};

MDI: PROC [mv: MaybeValue, ifNotFound: INT] RETURNS [INT]

~ INLINE {RETURN [IF mv.found THEN IF mv.it.ra#noRef THEN mv.it.i ELSE 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;

ints: READONLY Space --uses .i field as integer value--;

refs: READONLY Space --treats LOOPHOLE[.ra] like ints treats .i--;

cards, reals, times: READONLY Space;

spaceSpace: READONLY Space --based on representation, not behaviors--;

ropes: READONLY ARRAY --case matters--BOOL OF Space;

SpaceList: TYPE ~ LIST OF Space;

CreateLORASpace: PROC [prefix, repeat: SpaceList] RETURNS [Space];

Result is a space of LORA. Let n=Length[prefix], m=Length[repeat], and l be a member of the resulting space. The kth element of l is in space prefix[k], if k<n, otherwise it's in repeat[(k-n) MOD m]. The elements are ordered lexicographically.

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]};

SPrint: PROC [s: Space, v: Value, to: IO.STREAM, depth: INT ← 4, length: INT ← 32, verbose: BOOL ← FALSE];

SFormat: PROC [s: Space, v: Value, depth: INT ← 4, length: INT ← 32, verbose: BOOL ← FALSE] RETURNS [ROPE];

Intervals

Interval: TYPE ~ ARRAY End OF Value;

End: TYPE ~ {min, max};

fullInterval: READONLY Interval -- = ALL[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 [[IV[i.min], IV[i.max]]]};

Implementing Spaces

SpacePrivate: TYPE ~ MONITORED RECORD [

Contains: TestProc,

Equal: EqualProc,

Hash: HashProc,

Compare: CompareProc,

Print: PrintProc ← NIL,

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];

PrintProc: TYPE ~ PROC [data: REF ANY, v: Value, to: IO.STREAM, depth, length: INT, verbose: BOOL];

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]

~ 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]]};

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]

~ 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]]};