
    <<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.