SetBasicsImpl.Mesa
Last tweaked by Mike Spreitzer on December 10, 1987 12:09:19 pm PST
DIRECTORY Atom, Basics, Rope, RopeHash, SetBasics;
SetBasicsImpl:
CEDAR
MONITOR
LOCKS lp USING lp: LockPtr
IMPORTS Basics, Rope, RopeHash, SetBasics
EXPORTS SetBasics
=
BEGIN OPEN SetBasics;
LockPtr: TYPE ~ LONG POINTER TO MONITORLOCK;
basic: PUBLIC Space ~ NEW [SpacePrivate ← [Contains: BasicContains, Equal: BasicEqual, Hash: BasicHash, Compare: BasicCompare, name: "basic"]];
BasicContains: PROC [data: REF ANY, v: Value] RETURNS [BOOL] --TestProc-- ~ {RETURN[TRUE]};
BasicEqual:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [
BOOL]
--EqualProc-- ~ {
WITH v1
SELECT
FROM
x: RefAnyValue =>
WITH v2
SELECT
FROM
y: RefAnyValue => RETURN [x.a = y.a];
y: IntValue => RETURN [FALSE];
y: NotAValue => ERROR;
ENDCASE => ERROR;
x: IntValue =>
WITH v2
SELECT
FROM
y: RefAnyValue => RETURN [FALSE];
y: IntValue => RETURN [x.i = y.i];
y: NotAValue => ERROR;
ENDCASE => ERROR;
x: NotAValue => ERROR;
ENDCASE => ERROR};
BasicHash:
PROC [data:
REF
ANY, v: Value]
RETURNS [
CARDINAL]
--HashProc-- ~
TRUSTED {
WITH v
SELECT
FROM
no => ERROR;
a => RETURN HashRefI[a];
i => RETURN [HashIntI[i]];
ENDCASE => ERROR};
BasicCompare:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [Comparison]
--CompareProc-- ~
TRUSTED {
RETURN [
WITH v1
SELECT
FROM
x: RefAnyValue =>
WITH v2
SELECT
FROM
y: RefAnyValue => CompareRefI[x.a, y.a],
y: IntValue => less,
y: NotAValue => ERROR,
ENDCASE => ERROR,
x: IntValue =>
WITH v2
SELECT
FROM
y: IntValue => CompareIntI[x.i, y.i],
y: RefAnyValue => greater,
y: NotAValue => ERROR,
ENDCASE => ERROR,
x: NotAValue => ERROR,
ENDCASE => ERROR]};
refs: PUBLIC Space ~ NEW [SpacePrivate ← [Contains: RefsContains, Equal: BasicEqual, Hash: BasicHash, Compare: BasicCompare, name: "refs"]];
RefsContains: PROC [data: REF ANY, v: Value] RETURNS [BOOL] ~ {RETURN[v.kind=a]};
ints: PUBLIC Space ~ NEW [SpacePrivate ← [Contains: IntsContains, Equal: BasicEqual, Hash: BasicHash, Compare: BasicCompare, name: "ints"]];
IntsContains: PROC [data: REF ANY, v: Value] RETURNS [BOOL] ~ {RETURN[v.kind=i]};
ropes:
PUBLIC
ARRAY
--case matters--
BOOL
OF Space ~ [
FALSE: NEW [SpacePrivate ← [Contains: RopesContains, Equal: RopesEqual, Hash: RopesHash, Compare: RopesCompare, name: "ropes mod case", data: NEW [BOOL ← FALSE]]],
TRUE: NEW [SpacePrivate ← [Contains: RopesContains, Equal: RopesEqual, Hash: RopesHash, Compare: RopesCompare, name: "ropes with case", data: NEW [BOOL ← TRUE]]]];
RopesContains:
PROC [data:
REF
ANY, v: Value]
RETURNS [
BOOL] ~
TRUSTED {
RETURN [
WITH v
SELECT
FROM
a => a=NIL OR ISTYPE[a, ROPE],
i => FALSE,
no => ERROR,
ENDCASE => ERROR]};
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: BasicEqual, Hash: BasicHash, Compare: BasicCompare, name: "spaces"]];
SpacesContains:
PROC [data:
REF
ANY, v: Value]
RETURNS [
BOOL] ~
TRUSTED {
RETURN [
WITH v
SELECT
FROM
a => a#NIL AND ISTYPE[a, Space],
i => FALSE,
no => ERROR,
ENDCASE => ERROR]};
UpdateSpaceOther:
PUBLIC
PROC [s: Space,
Update:
PROC [Atom.PropList]
RETURNS [Atom.PropList]] ~
TRUSTED {
WithLock:
ENTRY
PROC [lp: LockPtr] ~
CHECKED {
ENABLE UNWIND => NULL;
s.other ← Update[s.other];
RETURN};
WithLock[@s.LOCK];
RETURN};
Lexer: TYPE ~ REF LexerPrivate;
LexerPrivate: TYPE ~ RECORD [prefix, repeat: OrderList];
LexLOV:
PUBLIC
PROC [prefix, repeat: OrderList]
RETURNS [Order] ~ {
lo: Lexer ~ NEW [LexerPrivate ← [prefix, repeat]];
RETURN [[LexLOVCompare, lo]]};
LexLOVCompare:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [c: Basics.Comparison ← equal] ~ {
lo: Lexer ~ NARROW[data];
l1: LOV ← NARROW[v1.VA];
l2: LOV ← NARROW[v2.VA];
ol: OrderList ← lo.prefix;
WHILE l1#
NIL
AND l2#
NIL
DO
IF ol=NIL THEN {ol ← lo.repeat; IF ol=NIL THEN ERROR};
IF (c ← ol.first.Compare[ol.first.data, l1.first, l2.first])#equal THEN RETURN;
l1 ← l1.rest;
l2 ← l2.rest;
ol ← ol.rest;
ENDLOOP;
RETURN [
SELECT
TRUE
FROM
l1#NIL => greater,
l2#NIL => less,
ENDCASE => equal];
};
LexLORA:
PUBLIC
PROC [prefix, repeat: OrderList]
RETURNS [Order] ~ {
lo: Lexer ~ NEW [LexerPrivate ← [prefix, repeat]];
RETURN [[LexLORACompare, lo]]};
LexLORACompare:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [c: Basics.Comparison ← equal] ~ {
lo: Lexer ~ NARROW[data];
l1: LORA ← NARROW[v1.VA];
l2: LORA ← NARROW[v2.VA];
ol: OrderList ← lo.prefix;
WHILE l1#
NIL
AND l2#
NIL
DO
IF ol=NIL THEN {ol ← lo.repeat; IF ol=NIL THEN ERROR};
IF (c ← ol.first.Compare[ol.first.data, [a[l1.first]], [a[l2.first]]])#equal THEN RETURN;
l1 ← l1.rest;
l2 ← l2.rest;
ol ← ol.rest;
ENDLOOP;
RETURN [
SELECT
TRUE
FROM
l1#NIL => greater,
l2#NIL => less,
ENDCASE => equal];
};
END.