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