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.