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 [BOOLFALSE]]],
TRUE: NEW [SpacePrivate ← [Contains: RopesContains, Equal: RopesEqual, Hash: RopesHash, Compare: RopesCompare, name: "ropes with case", data: NEW [BOOLTRUE]]]];
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: LOVNARROW[v1.VA];
l2: LOVNARROW[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: LORANARROW[v1.VA];
l2: LORANARROW[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.