DIRECTORY
Basics USING [BoundsCheck],
PFS,
PFSNames,
Rope USING [CompareSubstrs, ROPE, Substr];

PFSNamesImpl: CEDAR PROGRAM
IMPORTS Basics, PFS, PFSNames, Rope
EXPORTS PFSNames
~ BEGIN OPEN PFSNames;
PATH: TYPE = REF PathObject;
PathObject: TYPE = PFSNames.PathObject;
PrivatePathObject: PUBLIC TYPE = PACKED RECORD [
comps: PRIVATE Components Ź NIL,
lastComp: Component Ź [],
absolute: BOOL Ź FALSE,
directory: BOOL Ź FALSE,
unparsed: REF,
parent: PATH Ź NIL 
];

ComponentSequence: TYPE = RECORD [SEQUENCE count: [0..NAT.LAST) OF Component];
Components: TYPE = REF ComponentSequence;

NarrowPath: PUBLIC PROC [r: REF ANY] RETURNS [PATH] ~ {
RETURN [NARROW[r, PATH]];
};

IsPath: PUBLIC PROC [r: REF ANY] RETURNS [BOOL] ~ {
RETURN [ISTYPE[r, PATH]];
};
ConstructName: PUBLIC PROC [components: LIST OF Component, absolute, directory, reverse: BOOL Ź FALSE, unparsed: REF Ź NIL] RETURNS [name: PATH Ź NIL] ~ {
count: NAT Ź 0;
name Ź NEW [PathObject Ź [NEW[PrivatePathObject Ź []]]];
name.absolute Ź absolute;
name.directory Ź directory;
name.unparsed Ź unparsed;
FOR l: LIST OF Component Ź components, l.rest WHILE l#NIL DO
count Ź count+1;
ENDLOOP;
SELECT count FROM
0 => {
name.absolute Ź name.directory Ź absolute OR directory;
RETURN;
};
1 => NULL;
ENDCASE => name.comps Ź NEW[ComponentSequence[count-1]];
{
l: LIST OF Component Ź components;
IF reverse THEN {
name.lastComp Ź l.first;
l Ź l.rest;
FOR i: NAT DECREASING IN [0..count-1) DO
name.comps[i] Ź l.first;
l Ź l.rest
ENDLOOP;
}
ELSE {
FOR i: NAT IN [0..count-1) DO
name.comps[i] Ź l.first;
l Ź l.rest
ENDLOOP;
name.lastComp Ź l.first;
};
IF name.lastComp.name.base=NIL THEN name.lastComp.name Ź ["", 0, 0];
};
};
ExpandName: PUBLIC PROC [name: PATH, wDir: PATH Ź NIL] RETURNS [PATH] ~ {
name Ź LocalNonNIL[name];
wDir Ź LocalNonNIL[wDir];
IF name.absolute OR NOT wDir.absolute THEN RETURN[name];
{
privateName: REF PrivatePathObject Ź name­;
answer: PATH Ź NEW[PathObject Ź [NEW[PrivatePathObject Ź privateName­]]];
answer.absolute Ź TRUE;
[answer.comps, answer.lastComp] Ź AdjoinComps[wDir, 0, Count[wDir], name, 0, Count[name]];
RETURN[answer];
};
};
ComponentCount: PUBLIC PROC [name: PATH] RETURNS [count: NAT] ~ {
IF name=NIL THEN RETURN[0];
count Ź IF name.comps # NIL THEN name.comps.count+1 
ELSE IF (name.lastComp.name.base#NIL) OR (name.lastComp.version.versionKind#none)  -- OR
-- name.absolute OR 
-- name.directory
THEN 1 ELSE 0;
};

emptyComps: Components ~ NEW[ComponentSequence[0]];

Compare: PUBLIC PROC [n1, n2: PATH, case: BOOL Ź FALSE ] RETURNS [Comparison] ~ {
c: Comparison;
CompareBools: PROC [b1, b2: BOOL] RETURNS [Comparison] ~ {
SELECT TRUE FROM
~b1 AND b2 => RETURN[less];
b1 AND ~b2 => RETURN[greater];
ENDCASE => NULL;
RETURN[equal];
};

n1 Ź LocalNonNIL[n1];
n2 Ź LocalNonNIL[n2];
 
IF (c Ź CompareBools[n1.absolute, n2.absolute]) # equal THEN RETURN[c];
{
comps1: Components ~ IF n1.comps # NIL THEN n1.comps ELSE emptyComps;
comps2: Components ~ IF n2.comps # NIL THEN n2.comps ELSE emptyComps;
c1: NAT Ź comps1.count;
c2: NAT Ź comps2.count;
FOR p: NAT IN [0..MIN[c1, c2]) DO
IF (c Ź CompareComponents[comps1[p], comps2[p], case]) # equal THEN RETURN[c];
ENDLOOP;
SELECT TRUE FROM
c1 < c2 => {
IF (c Ź CompareComponents[n1.lastComp, comps2[c1], case]) # equal 
THEN RETURN[c] ELSE RETURN[less];
};
c1 > c2 => {
IF (c Ź CompareComponents[comps1[c2], n2.lastComp, case]) # equal 
THEN RETURN[c] ELSE RETURN[greater];
};
ENDCASE => NULL;
};
IF (c Ź CompareComponents[n1.lastComp, n2.lastComp, case]) # equal THEN RETURN[c];
RETURN[CompareBools[n1.directory, n2.directory]];
};

ShortName: PUBLIC PROC [name: PATH] RETURNS [shortName: Component] ~
{ RETURN[LocalNonNIL[name].lastComp] };

ShortNameRope: PUBLIC PROC [name: PATH] RETURNS [shortName: ROPE] ~
{ RETURN[InlineComponentRope[LocalNonNIL[name].lastComp]] };

InlineComponentRope: PROC [comp: Component] RETURNS [ROPE] ~ INLINE {
RETURN [Rope.Substr[comp.name.base, comp.name.start, comp.name.len]];
};

Cat: PUBLIC PROC [n1, n2: PATH] RETURNS [PATH] ~ {
seq: Components;
lastComp: Component;
absolute, directory: BOOL;
n1 Ź LocalNonNIL[n1];
n2 Ź LocalNonNIL[n2];
[seq, lastComp] Ź AdjoinComps[p1~n1, p2~n2];
absolute Ź n1.absolute OR (Count[n1]=0 AND n2.absolute);
directory Ź n2.directory OR (Count[n2]=0 AND n1.directory);
RETURN[NEW[PathObject Ź [NEW[PrivatePathObject Ź [absolute~absolute, directory~directory, lastComp~lastComp, comps~seq, parent~IF Count[n2]=1 THEN EnsureDirectory[n1] ELSE NIL]]]]];
};

SubName: PUBLIC PROC [name: PATH, start: NAT Ź 0, count: NAT Ź NAT.LAST, absolute, directory: BOOL Ź FALSE] RETURNS [PATH] ~ {
result: PATH Ź NEW[PathObject Ź [NEW[PrivatePathObject]]];
name Ź LocalNonNIL[name];
count Ź MIN[count, Count[name]-start];
result.absolute Ź absolute;
result.directory Ź directory;
SELECT count FROM
0 => {
result.directory Ź result.absolute Ź absolute OR directory;
RETURN[result];
};
1 => {
result.lastComp Ź Fetch[name, start];
IF result.lastComp.name.base=NIL THEN result.lastComp.name Ź ["", 0, 0];
RETURN[result];
};
ENDCASE => result.comps Ź NEW[ComponentSequence[count-1]];
FOR i: NAT IN [0..count-1) DO
result.comps[i] Ź Fetch[name, start+i];
ENDLOOP;
result.lastComp Ź Fetch[name, start+count-1];
RETURN[result];
};

Fetch: PUBLIC PROC [name: PATH, index: NAT] RETURNS [Component] ~ {
c: NAT;
name Ź LocalNonNIL[name];
[] Ź Basics.BoundsCheck[index, cŹCount[name]];
IF (c-1)=index THEN RETURN[name.lastComp] ELSE RETURN[name.comps[index]];
};

IsAPrefix: PUBLIC PROC [prefix, name: PATH] RETURNS [isa: BOOL, suffix: PATH] ~ {
prefix Ź LocalNonNIL[prefix];
name Ź LocalNonNIL[name];
{
pComps: NAT Ź Count[prefix];
nComps: NAT Ź Count[name];
IF pComps=0 AND ~prefix.absolute THEN { 
RETURN[TRUE, name];
};

IF (pComps >= nComps)  OR (prefix.absolute#name.absolute) THEN {
RETURN[FALSE, NIL];
};

FOR i: NAT IN [0.. pComps-1) DO
IF NOT EqualComponents[name.comps[i], prefix.comps[i]] THEN RETURN[FALSE, NIL];
ENDLOOP;
IF (pComps>0) AND NOT EqualComponents[prefix.lastComp, name.comps[pComps-1]] THEN RETURN[FALSE, NIL];

suffix Ź NEW[PathObject Ź [NEW[PrivatePathObject Ź []]]];
[suffix.comps, suffix.lastComp] Ź AdjoinComps[name, pComps, nComps-pComps, EmptyPath, 0,0];
suffix.absolute Ź NOT prefix.directory;
suffix.directory Ź name.directory;
RETURN[TRUE, suffix];
}; 
};

Count: PROC [name: PATH] RETURNS [count: NAT] ~ INLINE {
count Ź ComponentCount[name];
};

Error: ERROR ~ CODE;

IsADirectory: PUBLIC PROC [name: PATH] RETURNS [BOOL] ~ {
name Ź LocalNonNIL[name];
RETURN[name.directory] 
};

EnsureDirectory: PUBLIC PROC [name: PATH] RETURNS [PATH] ~ {
name Ź LocalNonNIL[name];
IF name.directory THEN RETURN[name];
{
answer: PATH Ź CopyPath[name];
answer.directory Ź TRUE;
answer.unparsed Ź NIL;
RETURN[answer];
};
};

IsAbsolute: PUBLIC PROC [name: PATH] RETURNS [BOOL] ~ {
name Ź LocalNonNIL[name];
RETURN[name.absolute] 
};

EnsureAbsolute: PUBLIC PROC [name: PATH] RETURNS [PATH] ~ {
name Ź LocalNonNIL[name];
IF name.absolute THEN RETURN[name];
{
answer: PATH Ź CopyPath[name];
answer.absolute Ź TRUE;
answer.unparsed Ź NIL;
RETURN[answer];
};
};

StripVersionNumber: PUBLIC PROC [name: PATH] RETURNS [PATH] ~ {
name Ź LocalNonNIL[name];
RETURN[NEW[PathObject Ź [NEW[PrivatePathObject Ź [name.comps, [name.lastComp.name, [none]], name.absolute, name.directory, NIL, name.parent]]]]];
};

SetVersionNumber: PUBLIC PROC [name: PATH, version: Version] RETURNS [PATH] ~ {
name Ź LocalNonNIL[name];
RETURN[NEW[PathObject Ź [NEW[PrivatePathObject Ź [name.comps, [name.lastComp.name, version], name.absolute, name.directory, NIL, name.parent]]]]];
};

ReplaceShortName: PUBLIC PROC [name: PATH, newShortName: Component] RETURNS [PATH] ~ {
name Ź LocalNonNIL[name];
RETURN[NEW[PathObject Ź [NEW[PrivatePathObject Ź [name.comps, newShortName, name.absolute, name.directory, NIL, name.parent]]]]];
};

ReplaceComponent: PUBLIC PROC [name: PATH, index: NAT, new: Component] RETURNS [PATH] ~ {
c: NAT;
name Ź LocalNonNIL[name];
[] Ź Basics.BoundsCheck[index, cŹCount[name]];
IF new.name.base=NIL THEN new.name.base Ź ""; -- must not convert 1 component name to 0 component name;
IF (c-1)=index THEN RETURN[NEW[PathObject Ź [NEW[PrivatePathObject Ź [name.comps, new, name.absolute, name.directory, NIL, name.parent]]]]]
ELSE {
newPath: PATH Ź NEW[PathObject Ź [NEW[PrivatePathObject Ź [NIL, name.lastComp, name.absolute, name.directory]]]];
newPath.comps Ź NEW[ComponentSequence[name.comps.count]];
FOR i: NAT IN [0..name.comps.count) DO
newPath.comps[i] Ź name.comps[i];
ENDLOOP;
newPath.comps[index] Ź new;
RETURN[ newPath ];
};
};

InASubdirectory: PUBLIC PROC [parent: PATH, name: PATH] RETURNS [BOOL] ~ {
isa: BOOL;
suffix: PATH;
name Ź LocalNonNIL[name];
parent Ź LocalNonNIL[parent];
[isa, suffix] Ź IsAPrefix[parent, name];
RETURN[isa AND Count[Directory[suffix]]#0];
};
FirstSubdirectory: PUBLIC PROC [parent: PATH, name: PATH] RETURNS [PATH] ~ {
isa: BOOL;
suffix: PATH;
parent Ź LocalNonNIL[parent];
name Ź LocalNonNIL[name];
[isa, suffix] Ź IsAPrefix[parent, name];
IF ~isa OR Count[Directory[suffix]]=0 THEN RETURN[NIL];
{
answer: PATH Ź CopyPath[parent];
answer.unparsed Ź NIL;
answer.parent Ź NIL;
[answer.comps, answer.lastComp] Ź AdjoinComps[name, 0, Count[parent]+1, EmptyPath, 0, 0];
RETURN[answer];
};
};
Directory: PUBLIC PROC [name: PATH] RETURNS [PATH] ~ {
IF (name Ź LocalNonNIL[name]).directory THEN RETURN[name];
RETURN[Parent[name]];
};
parentCalls: CARD Ź 0;
parentsNotCached: CARD Ź 0;

ParentCalls: PROC RETURNS [CARD] ~ { RETURN[parentCalls] };
ParentsNotCached: PROC RETURNS [CARD] ~ { RETURN[parentsNotCached] };

Parent: PUBLIC PROC [name: PATH] RETURNS [PATH] ~ {
nonNil: PATH ~ LocalNonNIL[name];
parentCalls Ź parentCalls+1;
IF nonNil.parent#NIL THEN RETURN[nonNil.parent]
ELSE {
answer: PATH Ź CopyPath[nonNil]; 
answer.unparsed Ź NIL;
answer.parent Ź NIL;
parentsNotCached Ź parentsNotCached+1;
IF Count[answer]=0 AND ~answer.absolute THEN Error[];
[answer.comps, answer.lastComp] Ź AdjoinComps[answer, 0, MAX[INTEGER[Count[answer]-1], 0], EmptyPath, 0, 0];
answer.directory Ź TRUE;
IF name#NIL THEN name.parent Ź answer;
RETURN[answer];
};
};

ConstructComponent: PUBLIC PROC [name: ComponentNamePart, version: Version Ź [none]]
RETURNS [Component] ~
{ RETURN[ [name: name, version: version] ] };

VersionToRope: PUBLIC PROC [v: Version] RETURNS [ROPE] ~
{ RETURN[PFS.RopeFromPath[ConstructName[LIST[[name: [NIL, 0, 0] , version: v]], FALSE, FALSE]] ] };

Replace: PUBLIC PROC [base: PATH, start: INT Ź 0, len: NAT Ź NAT.LAST, with: PATH]
RETURNS [PATH] ~ {
bl: INT ~ base.ComponentCount[];
wl: INT ~ with.ComponentCount[];
len Ź MIN[len, bl-start];
IF start=0 AND len=bl THEN RETURN [with];
IF len=0 AND wl=0 THEN RETURN [base];
{
cl: LIST OF Component Ź NIL;
FOR i: INT IN [0..start) DO cl Ź CONS[base.Fetch[i], cl] ENDLOOP;
FOR i: INT IN [0..wl) DO cl Ź CONS[with.Fetch[i], cl] ENDLOOP;
FOR i: INT IN [start+len..bl) DO cl Ź CONS[base.Fetch[i], cl] ENDLOOP;
RETURN [ConstructName[components: cl, absolute: base.IsAbsolute[], directory: base.IsADirectory, reverse: TRUE] ]
};
};

Map: PUBLIC PROC [name: PATH, componentProc: ComponentProc, separatorProc: SeparatorProc, ref: REF] ~ {
name Ź LocalNonNIL[name];
{
c: NAT Ź Count[name];
separatorProc[name.absolute, ref];
IF c=0 THEN RETURN;
FOR i: NAT IN [0..c-1) DO 
componentProc[Fetch[name, i], ref];
separatorProc[TRUE, ref];
ENDLOOP;
componentProc[Fetch[name, c-1], ref];
separatorProc[name.directory, ref];
};
};
CompareComponents: PUBLIC PROC [c1, c2: Component, case: BOOL] RETURNS [Comparison] ~ {
SELECT Rope.CompareSubstrs[
c1.name.base, c1.name.start, c1.name.len, 
c2.name.base, c2.name.start, c2.name.len, case] FROM
less => RETURN[less];
greater => RETURN[greater];
ENDCASE => NULL;
RETURN[CompareVersions[c1.version, c2.version]];
};
CompareVersions: PUBLIC PROC [v1, v2: Version] RETURNS [Comparison] ~ {
IF v1.versionKind#v2.versionKind THEN RETURN[incomparable];
IF v1.versionKind#numeric THEN RETURN[equal];
SELECT TRUE FROM 
v1.version<v2.version => RETURN[less];
v1.version>v2.version => RETURN[greater];
ENDCASE => RETURN[equal];
};
GetUnparsingHint: PUBLIC PROC [p: PATH] RETURNS [REF] ~ {
RETURN [p.unparsed];
};

SetUnparsingHint: PUBLIC PROC [p: PATH, r: REF] RETURNS [prev: REF] ~ {
prev Ź p.unparsed;
p.unparsed Ź r;
};
EmptyPath: PUBLIC PATH ~ NEW[PathObject Ź [NEW[PrivatePathObject]]];
LocalNonNIL: PROC [p: PATH] RETURNS [PATH] ~ INLINE {
RETURN[IF p=NIL THEN EmptyPath ELSE p];
};

CopyPath: PROC [path: PATH] RETURNS [PATH] ~ {
privatePath: REF PrivatePathObject ~ path­;
RETURN[ NEW[PathObject Ź [NEW[PrivatePathObject Ź privatePath­]]] ];
};

AdjoinComps: PROC [
p1: PATH, s1: NAT Ź 0, c1: NAT Ź LAST[NAT], 
p2: PATH Ź NIL, s2: NAT Ź 0, c2: NAT Ź LAST[NAT] ]
RETURNS [seq: Components Ź NIL, lastComp: Component Ź [] ] ~ {
count1: NAT Ź Count[p1];
count2: NAT Ź Count[p2];
c1 Ź MIN[c1, count1-s1];
c2 Ź MIN[c2, count2-s2];
{
CopyComps: PROC [from: PATH, fromStart, count: NAT, to: Components, toStart: NAT] ~ {
j: NAT Ź fromStart;
FOR i: NAT IN [toStart..MIN[toStart+count, to.count]) DO
to[i] Ź Fetch[from, j];
j Ź j+1;
ENDLOOP;
};
newCount: NAT Ź c1+c2;
SELECT newCount FROM
0 => { RETURN };
1 => { NULL };
ENDCASE => seq Ź NEW[ComponentSequence[newCount-1]];
lastComp Ź IF c2 > 0 THEN Fetch[p2, s2+c2-1] ELSE Fetch[p1, s1+c1-1];
IF seq = NIL THEN RETURN;
CopyComps[from: p1, fromStart: s1, count: c1, to: seq, toStart: 0];
CopyComps[from: p2, fromStart: s2, count: c2, to: seq, toStart: c1];
};
};

END.
  Ú  
PFSNamesImpl.mesa
Copyright Ó 1988, 1989, 1991 by Xerox Corporation.  All rights reserved.
Carl Hauser, August 28, 1989 5:29:31 pm PDT
Bill Jackson (bj) May 31, 1989 11:21:34 pm PDT
Chauser, October 22, 1990 5:26 pm PDT
Willie-s, August 20, 1991 6:10 pm PDT

Representation
comps[0] is most significant
IF pathKind = absolute, the first two components provide the protocol and server name.
Clients (and the implementation) must treat the comps^ as immutable, since it may be shared.  
maybe we should provide extension parsing of this as well?
lastComp is not included in comps: the idea is to let the implementation share comps structures between Paths differing only in the last component.
absolute => path is absolute, i.e. begins with protocol, server, etc.
~absolute=> path is relative to some, as yet unspecified, working directory
As a wDir argument, ~absolute implies no working directory, since working directories must be absolute.
directory=> name is syntactically that of a directory
~directory=> name is syntactically that of a file
an unparsing hint; the various parsers may store something here to help them unparse fast.
another hint.  If non-NIL, refers to a path object representing the parent directory for this object.
Type Manipulation
Parsing and Constructing Names 

A convenient way to construct names without parsing.
Count the components
Allocate room in the sequence for all but the last
Copy the components to the PATH
We don't want a 1-component name to inadvertantly look like a 0-component name.
Operations Within the Algebra of Names
If name is not absolute then prepends wDir.

Assert (comps1.count=comps2.count)
We don't want a 1-component name to inadvertantly look like a 0-component name.
a relative, empty name is a prefix of anything.
prefix too long, or unmatched absoluteness.
some doubt about whether excluding equal lengths is useful.
Now compute the suffix
returns name with [none[]] substituted for name.version.
returns name with version substituted for name.version.
assert: name.comps#NIL
This implementation could be more efficient; it's not necessary to construct the suffix and Directory[suffix]

If NOT InASubdirectory[parent, name] then returns NIL.  Otherwise, returns the part of name up to and including the first subdirectory after the end of parent.

Return the directory part of the name.

If name is a directory, then returns the parent directory.  If name is a file, then returns the containing directory.  In either case, this means that Parent returns the directory which contains the object denoted by name.
Operations on Components
Operations on Versions
Unparsing Hint
Helpers
This is also in the interface, but this is better for use in the Impl because it doesn't indirect through the interface record to get to the EmptyPath.
caller must ensure path is non-NIL;
Combined Substring and Cat; avoids the allocations one would do to do them separately. 
caller must assure that p1 and p2 are non-NIL 

NAT.LAST => { ERROR }; -- maybe?
assert:  c2 > 0 OR c1 > 0
 Ę¤  (cedarcode) styleNewlineDelimiter
 Icode
Ďe=HK++K..K%K%K Ďk		KKK	K
*K KĐlnK	#K	K
headKK'	0 KKVVK^K:Kr
KEEKKKKggK55K11
KZKeKK KNK)K Ďn
Ďc7KKK  Ą3KKK  *K4KK8KKKK <KKK2K*7KKK
K8KK"	KK	
(KK
KKKK
KKKKOK!DKK& 
IK++KKK
8K+K%IKKZK	KKK  	AKK+Ą-ĂKK K3K  
QK 
:KK
KKKK KKKK6GK	
EK	
EKK	
!K=NKK@BK!KK@BK
$KKKK""KARK+1KK 
 	DK'K  CK4<K 
 EK?EKK  
2KKKKKK,,K8K;KcľKK  	~K:KK&KKK.;K	KK%%KOK#HK	KK:K''KK-K	KK  	CKKK.K
IKK  	
QKKKK
(K/KKK !@K+K;KKK K1OKK8eK KK	9K[[K'K""K
KKK  	8KKK  K  9KKKK  <KK$KKKK	KKK  
7KKKK  ;KK#KKKK	KKK  ?K8KK_KK  OK77KK`KK  VKKOKK  	YKKK.KĄ9gK[KK		3qK&9&K!!KKKKKK  
JKmK
KKKK((K+KK  
LK,jK
KKKK((K
7K KKKYYK	KKK  	6K&K&:KKK KKK K
 ;K
 EK  3KŢK!KK/K!KKK&&K	5K9(lKK&K	KKK  6jK%-K 
 8K	cK  	eK K KK	)K%KKAK	>KFKdqKKK 
 CgKKK""K
K##KKK%%K##KK
 Wq{KK
KK*0K GK;K-K&K
)KK 9KKK  GKKKK
 	D 5K
'KKK 
 .K#K+K'DKK  

 ˛KWK*.K KKKK
 	UK	8KKKKK
	
KKK  K
 4KKEKKCKDKKK K     4x  Uö  