SetBasicsImpl.Mesa
Last tweaked by Mike Spreitzer on March 8, 1988 2:42:37 pm PST
DIRECTORY AbSets, AMBridge, AMTypes, Atom, Basics, IO, PrintTV, Rope, RopeHash, SetBasics;
SetBasicsImpl:
CEDAR
MONITOR
LOCKS lp USING lp: LockPtr
IMPORTS AMBridge, Basics, IO, PrintTV, Rope, RopeHash, SetBasics
EXPORTS SetBasics, AbSets
=
BEGIN OPEN SetBasics;
TV: TYPE ~ AMTypes.TV;
LockPtr: TYPE ~ LONG POINTER TO MONITORLOCK;
noRef: PUBLIC NoRef ~ NEW [NoReferent];
noValue: PUBLIC Value ~ [ra: noRef, i: 0];
noMaybe: PUBLIC MaybeValue ~ [found: FALSE, it: noValue];
fullInterval: PUBLIC Interval ~ ALL[noValue];
VTv:
PROC [x: Value]
RETURNS [
TV] ~
TRUSTED
INLINE {
RETURN [AMBridge.TVForReferent[NEW [Value ← x], const]]};
ITv:
PROC [x:
INT]
RETURNS [
TV] ~
TRUSTED
INLINE {
RETURN [AMBridge.TVForReferent[NEW [INT ← x], const]]};
RaTv:
PROC [x:
REF
ANY]
RETURNS [
TV] ~
TRUSTED
INLINE {
RETURN [AMBridge.TVForReferent[NEW [REF ANY ← x], const]]};
SPrint:
PUBLIC
PROC [s: Space, v: Value, to:
IO.
STREAM, depth:
INT ← 4, length:
INT ← 32, verbose:
BOOL ←
FALSE] ~ {
IF s.Print #
NIL
THEN {
s.Print[s.data, v, to, depth, length, verbose];
RETURN}
ELSE
IF v=noValue
THEN {
to.PutRope["SetBasics.noValue"];
RETURN}
ELSE {
SELECT
TRUE
FROM
v.ra=NIL => to.Put[[integer[v.i]]];
v.i=0 => PrintTV.Print[tv: RaTv[v.ra], put: to, depth: depth, width: length, verbose: verbose];
ENDCASE => PrintTV.Print[tv: VTv[v], put: to, depth: depth, width: length, verbose: verbose];
RETURN};
};
SFormat:
PUBLIC
PROC [s: Space, v: Value, depth:
INT ← 4, length:
INT ← 32, verbose:
BOOL ←
FALSE]
RETURNS [
ROPE] ~ {
to: IO.STREAM ~ IO.ROS[];
SPrint[s, v, to, depth, length, verbose];
RETURN [to.RopeFromROS]};
BasicContains: PROC [data: REF ANY, v: Value] RETURNS [BOOL] --TestProc-- ~ {RETURN[TRUE]};
refs: PUBLIC Space ~ NEW [SpacePrivate ← [Contains: BasicContains, Equal: RefsEqual, Hash: RefsHash, Compare: RefsCompare, Print: RefsPrint, name: "refs"]];
RefsEqual: PROC [data: REF ANY, v1, v2: Value] RETURNS [BOOL] --EqualProc-- ~ {RETURN [v1.ra=v2.ra]};
RefsHash: PROC [data: REF ANY, v: Value] RETURNS [CARDINAL] --HashProc-- ~ {RETURN HashRefI[v.ra]};
RefsCompare: PROC [data: REF ANY, v1, v2: Value] RETURNS [Comparison] --CompareProc-- ~ {RETURN CompareRefI[v1.ra, v2.ra]};
RefsPrint:
PROC [data:
REF
ANY, v: Value, to:
IO.
STREAM, depth, length:
INT, verbose:
BOOL] ~ {
IF v=noValue
THEN to.PutRope["SetBasics.noValue"]
ELSE PrintTV.Print[tv: RaTv[v.ra], put: to, depth: depth, width: length, verbose: verbose];
RETURN};
ints: PUBLIC Space ~ NEW [SpacePrivate ← [Contains: BasicContains, Equal: IntsEqual, Hash: IntsHash, Compare: IntsCompare, name: "ints"]];
IntsEqual: PROC [data: REF ANY, v1, v2: Value] RETURNS [BOOL] --EqualProc-- ~ {RETURN [v1.i=v2.i]};
IntsHash: PROC [data: REF ANY, v: Value] RETURNS [CARDINAL] --HashProc-- ~ {RETURN [HashIntI[v.i]]};
IntsCompare: PROC [data: REF ANY, v1, v2: Value] RETURNS [Comparison] --CompareProc-- ~ {RETURN CompareIntI[v1.i, v2.i]};
ropes:
PUBLIC
ARRAY
--case matters--
BOOL
OF Space ~ [
FALSE: NEW [SpacePrivate ← [Contains: RopesContains, Equal: RopesEqual, Hash: RopesHash, Compare: RopesCompare, Print: RefsPrint, name: "ropes mod case", data: NEW [BOOL ← FALSE]]],
TRUE: NEW [SpacePrivate ← [Contains: RopesContains, Equal: RopesEqual, Hash: RopesHash, Compare: RopesCompare, Print: RefsPrint, name: "ropes with case", data: NEW [BOOL ← TRUE]]]];
RopesContains:
PROC [data:
REF
ANY, v: Value]
RETURNS [
BOOL] ~ {
RETURN [
WITH v.ra
SELECT
FROM
x: ROPE => TRUE,
ENDCASE => FALSE]};
RopesHash:
PROC [data:
REF
ANY, v: Value]
RETURNS [
CARDINAL] ~ {
r: ROPE ~ NARROW[v.VA];
case: REF BOOL ~ NARROW[data];
RETURN [RopeHash.FromRope[r, case^]]};
RopesEqual:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [
BOOL] ~ {
r1: ROPE ~ NARROW[v1.VA];
r2: ROPE ~ NARROW[v2.VA];
case: REF BOOL ~ NARROW[data];
RETURN r1.Equal[r2, case^]};
RopesCompare:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [Comparison] ~ {
r1: ROPE ~ NARROW[v1.VA];
r2: ROPE ~ NARROW[v2.VA];
case: REF BOOL ~ NARROW[data];
RETURN r1.Compare[r2, case^]};
spaceSpace: PUBLIC Space ~ NEW [SpacePrivate ← [Contains: SpacesContains, Equal: RefsEqual, Hash: RefsHash, Compare: RefsCompare, Print: SpacesPrint, name: "spaces"]];
SpacesContains:
PROC [data:
REF
ANY, v: Value]
RETURNS [
BOOL] ~ {
RETURN [
WITH v.ra
SELECT
FROM
x: Space => TRUE,
ENDCASE => FALSE]};
SpacesPrint:
PROC [data:
REF
ANY, v: Value, to:
IO.
STREAM, depth, length:
INT, verbose:
BOOL] ~ {
WITH v.ra
SELECT
FROM
x: NoRef => to.PutRope["SetBasics.noValue"];
x: Space =>
SELECT depth
FROM
>1 => to.PutF["space(%g)", [rope[x.name]]];
ENDCASE => to.PutRope["space"];
ENDCASE => ERROR};
UpdateSpaceOther:
PUBLIC
PROC [s: Space,
Update:
PROC [Atom.PropList]
RETURNS [Atom.PropList]] ~ {
WithLock:
ENTRY
PROC [lp: LockPtr] ~ {
ENABLE UNWIND => NULL;
s.other ← Update[s.other];
RETURN};
TRUSTED {WithLock[@s.LOCK]};
RETURN};
Lexer: TYPE ~ REF LexerPrivate;
LexerPrivate: TYPE ~ RECORD [prefix, repeat: SpaceList];
CreateLORASpace:
PUBLIC
PROC [prefix, repeat: SpaceList]
RETURNS [space: Space] ~ {
Fmt:
PROC [sl: SpaceList]
RETURNS [rope:
ROPE ←
NIL] ~ {
FOR sl ← sl, sl.rest
WHILE sl#
NIL
DO
rope ← IF rope=NIL THEN sl.first.name ELSE rope.Cat[", ", sl.first.name];
ENDLOOP;
RETURN};
space ←
NEW [SpacePrivate ← [
Contains: LORAContains,
Equal: LORAEqual,
Hash: LORAHash,
Compare: LORACompare,
Print: RefsPrint,
name: Rope.Cat["LORA space [", Fmt[prefix], "] [", Fmt[repeat], "]"],
data: NEW [LexerPrivate ← [prefix, repeat]]
]];
RETURN};
LORAContains:
PROC [data:
REF
ANY, v: Value]
RETURNS [
BOOL] ~ {
RETURN [
WITH v.ra
SELECT
FROM
x: LORA => TRUE,
ENDCASE => FALSE]};
LORAHash:
PROC [data:
REF
ANY, v: Value]
RETURNS [hash:
CARDINAL ← 0] ~ {
lr: Lexer ~ NARROW[data];
sl: SpaceList ← lr.prefix;
FOR l:
LORA ←
NARROW[v.ra], l.rest
WHILE l #
NIL
DO
IF sl=NIL THEN {sl ← lr.repeat; IF sl=NIL THEN ERROR};
hash ← hash*5 + sl.first.SHash[AV[l.first]];
sl ← sl.rest;
ENDLOOP;
RETURN};
LORAEqual:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [
BOOL] ~ {
RETURN [LORACompare[data, v1, v2]=equal]};
LORACompare:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [c: Basics.Comparison ← equal] ~ {
lr: Lexer ~ NARROW[data];
l1: LORA ← NARROW[v1.VA];
l2: LORA ← NARROW[v2.VA];
sl: SpaceList ← lr.prefix;
WHILE l1#
NIL
AND l2#
NIL
DO
IF sl=NIL THEN {sl ← lr.repeat; IF sl=NIL THEN ERROR};
IF (c ← sl.first.SCompare[AV[l1.first], AV[l2.first]])#equal THEN RETURN;
l1 ← l1.rest;
l2 ← l2.rest;
sl ← sl.rest;
ENDLOOP;
RETURN [
SELECT
TRUE
FROM
l1#NIL => greater,
l2#NIL => less,
ENDCASE => equal];
};
END.