<<>>
    <<VersionMap2ImplrImpl.Mesa>>
        <<Copyright Ó 1990 by Xerox Corporation.  All rights reserved.>>
        <<Last tweaked by Mike Spreitzer on April 10, 1992 9:32 am PDT>>

    DIRECTORY Atom, Basics, IO, List, MorePfsNames, PFSNames, Process, Rope, VersionMap2, VersionMap2Implr;

    VersionMap2ImplrImpl: CEDAR MONITOR
        IMPORTS IO, List, PFSNames, Process, Rope, VersionMap2, VersionMap2Implr
        EXPORTS VersionMap2, VersionMap2Implr
        =

    BEGIN OPEN MPfsN:MorePfsNames, VersionMap2, VersionMap2Implr;

    LORA: TYPE ~ LIST OF REF ANY;

    FillinDefaults: PUBLIC PROC [functional: BOOL, mutability: Mutability, classRep: MapClassRep] RETURNS [MapClass] ~ {
        OPEN classRep;
        IF Functional=NIL THEN Functional _ IF functional THEN AlwaysFunctional ELSE NeverFunctional;
        IF MMutability=NIL THEN MMutability _ SELECT mutability FROM constant => AlwaysConstant, readonly => AlwaysReadonly, writable => 
        AlwaysWritable, ENDCASE => ERROR;
        IF Scan=NIL THEN Scan _ IF CreateGenerator#NIL THEN ScanByGenerate ELSE CantScan;
        IF CreateGenerator=NIL THEN CreateGenerator _ IF Scan=CantScan THEN CantGenerate ELSE GenerateByScan;
        IF Has=NIL THEN Has _ HasByScan;
        IF Size=NIL THEN Size _ SizeByScan;
        IF PatternFactorMap=NIL THEN PatternFactorMap _ DefaultPatternFactorMap;
        IF mutability#writable THEN {
            IF AddTuple=NIL THEN AddTuple _ CantAddTuple;
            IF AddMap=NIL THEN AddMap _ CantAddMap;
            IF RemTuple=NIL THEN RemTuple _ CantRemTuple;
            IF RemMap=NIL THEN RemMap _ CantRemMap}
        ELSE {
            IF AddTuple=NIL AND AddMap=NIL
                THEN {AddTuple _ CantAddTuple; AddMap _ CantAddMap}
            ELSE {
                IF AddTuple=NIL THEN AddTuple _ AddTupleBySingleton;
                IF AddMap=NIL THEN AddMap _ AddMapByTuples};
            IF RemTuple=NIL AND RemMap=NIL
                THEN {RemTuple _ CantRemTuple; RemMap _ CantRemMap}
            ELSE {
                IF RemTuple=NIL THEN RemTuple _ RemTupleBySingleton;
                IF RemMap=NIL THEN RemMap _ RemMapByTuples};
            };
        IF Negate=NIL THEN Negate _ DefaultNegate;
        IF IsNegation=NIL THEN IsNegation _ DefaultIsNegation;
        IF Intersect=NIL THEN Intersect _ DefaultIntersect;
        IF IsIntersection=NIL THEN IsIntersection _ DefaultIsIntersection;
        IF Union=NIL THEN Union _ DefaultUnion;
        IF IsUnion=NIL THEN IsUnion _ DefaultIsUnion;
        IF Difference=NIL THEN Difference _ DefaultDifference;
        IF IsDifference=NIL THEN IsDifference _ DefaultIsDifference;
        IF SymmetricDifference=NIL THEN SymmetricDifference _ DefaultSymmetricDifference;
        IF IsSymmetricDifference=NIL THEN IsSymmetricDifference _ DefaultIsSymmetricDifference;
        RETURN [NEW [MapClassRep _ classRep]]};

    AlwaysFunctional: PUBLIC PROC [map: Map] RETURNS [BOOL] ~ {RETURN [TRUE]};
    NeverFunctional: PUBLIC PROC [map: Map] RETURNS [BOOL] ~ {RETURN [FALSE]};
    AlwaysConstant: PUBLIC PROC [map: Map] RETURNS [Mutability] ~ {RETURN [constant]};
    AlwaysReadonly: PUBLIC PROC [map: Map] RETURNS [Mutability] ~ {RETURN [readonly]};
    AlwaysWritable: PUBLIC PROC [map: Map] RETURNS [Mutability] ~ {RETURN [writable]};

    HasByScan: PUBLIC PROC [map: Map, elt: VersionTuple] RETURNS [BOOL] ~ {
        RETURN [map.class.Scan[map, AlwaysAccept, FALSE, [elt]].found]};

    ScanByGenerate: PUBLIC PROC [map: Map, Consume: TupleConsumer, inOrder: BOOL, pfml: PatternFactoredMapList] RETURNS [MaybeTuple] ~ {
        gen: Generator ~ map.class.CreateGenerator[map, inOrder, pfml];
        DO
            t: VersionTuple _ gen.Next[gen];
            IF t=nullTuple THEN RETURN [noMaybe];
            IF Consume[t] THEN RETURN [[TRUE, t]];
            ENDLOOP};

    SortScan: PUBLIC PROC [map: Map, Scan: ScanProc, Consume: TupleConsumer, pfml: PatternFactoredMapList] RETURNS [MaybeTuple] ~ {
        list: LORA _ NIL;
        Note: PROC [t: VersionTuple] RETURNS [BOOL] ~ {
            list _ CONS[NEW [VersionTuple _ t], list];
            RETURN [FALSE]};
        IF Scan[map, Note, FALSE, pfml].found THEN ERROR;
        list _ List.Sort[list, SortCompare];
        FOR list _ list, list.rest WHILE list#NIL DO
            rt: REF VersionTuple ~ NARROW[list.first];
            IF Consume[rt^] THEN RETURN [[TRUE, rt^]];
            ENDLOOP;
        RETURN [noMaybe]};

    SortCompare: PROC [ref1, ref2: REF ANY] RETURNS [Basics.Comparison] ~ {
        rt1: REF VersionTuple ~ NARROW[ref1];
        rt2: REF VersionTuple ~ NARROW[ref2];
        RETURN rt1^.TupleCompare[rt2^]};

    FilterScan: PUBLIC PROC [map: Map, Scan: ScanProc, Consume: TupleConsumer, inOrder: BOOL, pfml: PatternFactoredMapList] RETURNS 
    [MaybeTuple] ~ {
        Pass: PROC [t: VersionTuple] RETURNS [BOOL] ~ {
            RETURN [PfmlHas[pfml, t] AND Consume[t]]};
        RETURN Scan[map, Pass, inOrder, []]};

    CantScan: PUBLIC ScanProc ~ {
        Cant[map.Refify, "this map can't enumerate its members"]; ERROR};

    GenerateByScan: PUBLIC PROC [map: Map, inOrder: BOOL, pfml: PatternFactoredMapList] RETURNS [Generator] ~ {
        fg: ForkedGen ~ NEW [ForkedGenPrivate _ []];
        TRUSTED {Process.Detach[FORK ForkedGenerate[fg, map, inOrder, pfml]]};
        RETURN [NEW [GeneratorRep _ [ForkedNext, ForkedClose, fg]]]};

    ForkedGen: TYPE ~ REF ForkedGenPrivate;
    ForkedGenPrivate: TYPE ~ RECORD [
        empty: BOOL _ TRUE,
        stop: BOOL _ FALSE,
        t: VersionTuple _ nullTuple,
        change: CONDITION];

    ForkedGenerate: PROC [fg: ForkedGen, map: Map, inOrder: BOOL, pfml: PatternFactoredMapList] ~ {
        Note: ENTRY PROC [t: VersionTuple] RETURNS [BOOL] ~ {
            ENABLE UNWIND => NULL;
            UNTIL fg.empty OR fg.stop DO WAIT fg.change ENDLOOP;
            IF fg.stop THEN RETURN [TRUE];
            fg.t _ t;
            fg.empty _ FALSE;
            NOTIFY fg.change;
            RETURN [FALSE]};
        [] _ map.class.Scan[map, Note, inOrder, pfml];
        RETURN};

    ForkedNext: ENTRY PROC [gen: Generator] RETURNS [t: VersionTuple] ~ {
        ENABLE UNWIND => NULL;
        fg: ForkedGen ~ NARROW[gen.data];
        WHILE fg.empty AND NOT fg.stop DO WAIT fg.change ENDLOOP;
        IF fg.stop THEN ERROR Error[[client, $GeneratorClosed]];
        t _ fg.t;
        fg.empty _ TRUE;
        NOTIFY fg.change;
        RETURN};

    ForkedClose: ENTRY PROC [gen: Generator] ~ {
        ENABLE UNWIND => NULL;
        fg: ForkedGen ~ NARROW[gen.data];
        fg.stop _ TRUE;
        NOTIFY fg.change;
        RETURN};

    CantGenerate: PUBLIC PROC [map: Map, inOrder: BOOL, pfml: PatternFactoredMapList] RETURNS [Generator] ~ {
        Cant[map.Refify, "this map can't enumerate its members"]; RETURN [NIL]};

    SizeByScan: PUBLIC PROC [map: Map, limit: INT] RETURNS [size: INT _ 0] ~ {
        Count: PROC [VersionTuple] RETURNS [BOOL] ~ {
            size _ size.SUCC;
            RETURN [size >= limit]};
        [] _ map.Scan[Count, FALSE];
        RETURN};

    FullSize: PUBLIC PROC [map: Map, limit: INT] RETURNS [INT] ~ {RETURN [INT.LAST]};

    DefaultPatternFactorMap: PUBLIC PROC [map: Map] RETURNS [PatternFactoredMap] ~ {RETURN [[nullTuple, aFull, map]]};

    CantAddTuple: PUBLIC PROC [map: Map, t: VersionTuple, if: IfHads] RETURNS [had: Hads] ~ {
        Cant[map.Refify, "this map doesn't allow additions"]; RETURN [ALL[none]]};

    AddTupleBySingleton: PUBLIC PROC [map: Map, t: VersionTuple, if: IfHads] RETURNS [had: Hads] ~ {
        s: Map ~ CreateSingleton[t];
        some: HadSets ~ map.AddMap[s, if];
        FOR df: DependentField IN DependentField DO
            FOR h: Had IN Had DO
                IF some[df][h] THEN {had[df] _ h; EXIT};
                REPEAT
                FINISHED => ERROR
                ENDLOOP;
            ENDLOOP;
        RETURN};

    CantAddMap: PUBLIC PROC [map, other: Map, if: IfHads] RETURNS [some: HadSets] ~ {
        Cant[map.Refify, "this map doesn't allow additions"]; RETURN [ALL[ALL[FALSE]]]};

    AddMapByTuples: PUBLIC PROC [map, other: Map, if: IfHads] RETURNS [some: HadSets] ~ {
        AddThisOne: PROC [t: VersionTuple] RETURNS [BOOL] ~ {
            hads: Hads ~ map.AddTuple[t, if];
            some[created][hads[created]] _ TRUE;
            some[stamp][hads[stamp]] _ TRUE;
            RETURN [FALSE]};
        some _ ALL[ALL[FALSE]];
        IF other.Scan[AddThisOne, FALSE].found THEN ERROR;
        RETURN};

    CantRemTuple: PUBLIC PROC [map: Map, t: VersionTuple] RETURNS [had: Hads] ~ {
        Cant[map.Refify, "this map doesn't allow deletions"]; RETURN [ALL[none]]};

    RemTupleBySingleton: PUBLIC PROC [map: Map, t: VersionTuple] RETURNS [had: Hads] ~ {
        s: Map ~ CreateSingleton[t];
        some: HadSets ~ map.RemMap[s];
        FOR df: DependentField IN DependentField DO
            FOR h: Had IN Had DO
                IF some[df][h] THEN {had[df] _ h; EXIT};
                REPEAT
                FINISHED => ERROR
                ENDLOOP;
            ENDLOOP;
        RETURN};

    CantRemMap: PUBLIC PROC [map, other: Map] RETURNS [some: HadSets] ~ {
        Cant[map.Refify, "this map doesn't allow deletions"]; RETURN [ALL[ALL[FALSE]]]};

    RemMapByTuples: PUBLIC PROC [map, other: Map] RETURNS [some: HadSets] ~ {
        RemThisOne: PROC [t: VersionTuple] RETURNS [BOOL] ~ {
            hads: Hads ~ map.RemTuple[t];
            some[created][hads[created]] _ TRUE;
            some[stamp][hads[stamp]] _ TRUE;
            RETURN [FALSE]};
        some _ ALL[ALL[FALSE]];
        IF other.Scan[RemThisOne, FALSE].found THEN ERROR;
        RETURN};

    emptyClass: MapClass ~ FillinDefaults[TRUE, constant, [
        Has: Order0Has,
        Scan: EmptyScan,
        Size: Order0Size,
        Negate: Order0Negate,
        IsNegation: Order0IsNegation,
        data: NIL]];

    fullClass: MapClass ~ FillinDefaults[FALSE, constant, [
        Has: Order0Has,
        Size: Order0Size,
        data: NIL]];

    Order0Has: PROC [map: Map, elt: VersionTuple] RETURNS [BOOL]
        ~ {RETURN [SELECT map.data FROM $Empty => FALSE, $Full => TRUE, ENDCASE => ERROR]};

    EmptyScan: PROC [map: Map, Consume: TupleConsumer, inOrder: BOOL, pfml: PatternFactoredMapList] RETURNS [MaybeTuple] ~ {
        RETURN [noMaybe]};

    Order0Size: PROC [map: Map, limit: INT] RETURNS [INT]
        ~ {RETURN [SELECT map.data FROM $Empty => 0, $Full => limit, ENDCASE => ERROR]};

    Order0Negate: PROC [map: Map] RETURNS [Map] ~ {
        SELECT map.data FROM
            $Empty => RETURN [aFull];
            $Full => RETURN [anEmpty];
            ENDCASE => ERROR};

    Order0IsNegation: PROC [map: Map] RETURNS [MaybeMap] ~ {
        SELECT map.data FROM
            $Empty => RETURN [[TRUE, aFull]];
            $Full => RETURN [[TRUE, anEmpty]];
            ENDCASE => ERROR};

    anEmpty: PUBLIC Map ~ [emptyClass, $Empty];
    aFull: PUBLIC Map ~ [fullClass, $Full];

    listOfEmpty: PUBLIC MapList ~ LIST[anEmpty];

    NamePatternAcceptsAll: PUBLIC PROC [pattern: Name, minDirBoundaries: NAT] RETURNS [BOOL] ~ {
        IF pattern=nullName THEN RETURN [TRUE];
        {cc: NAT ~ pattern.ComponentCount[];
        someDuble: BOOL _ FALSE;
        IF cc > minDirBoundaries.SUCC THEN RETURN [FALSE];
        FOR i: INT IN [0 .. cc) DO
            c: PFSNames.Component ~ FixFetch[pattern, i];
            IF c.name.len=0 THEN RETURN [FALSE];
            IF c.version # [all] THEN RETURN [FALSE];
            FOR j: INT IN [0..c.name.len) DO
                IF c.name.base.Fetch[c.name.start+j] # '* THEN RETURN [FALSE];
                ENDLOOP;
            someDuble _ someDuble OR c.name.len > 1;
            ENDLOOP;
        RETURN [someDuble]}};

    Cant: PUBLIC PROC [info: REF ANY, fmt: ROPE, v1, v2, v3, v4, v5: IO.Value _ [null[]]] ~ {
        ERROR Error[[client, cantCode, IO.PutFLR[fmt, LIST[v1, v2, v3, v4, v5]], info]]};

    DullClose: PUBLIC PROC [Generator] ~ {RETURN};

    FixFetch: PROC [path: Name, i: INT] RETURNS [PFSNames.Component]
        ~ {RETURN path.Fetch[i]--assume PFS returns decent rope parts--};

    END.