1 (* Modified from the ML Kit
4.1.4; basislib
/Path
.sml
2 * by mfluet@acm
.org on
2005-8-10 based on
3 * modifications from the ML Kit
3 Version
; basislib
/Path
.sml
4 * by sweeks@research
.nj
.nec
.com on
1999-1-5.
7 structure OS_Path
: OS_PATH
=
13 (* It would make sense to use substrings for internal versions
of
14 * fromString
and toString
, and to allocate new strings only when
15 * externalizing the strings
.
18 UNIX
: {isAbs
= false, vol
= _
, arcs
= "" :: _
}
19 Mac
: {isAbs
= true, vol
= _
, arcs
= "" :: _
}
24 val op sub
= String.sub
25 val substring
= String.extract
29 open Primitive
.MLton
.Platform
.OS
34 (* the path separator used
in canonical paths
*)
35 val slash
= if isWindows
then "\\" else "/"
37 (* MinGW
and newer Windows commands treat both
/ and \
as path
40 * Sadly this means that toString
o fromString is not the identity
41 * b
/c foo
/bar
-> foo
\bar
. However
, there
's nothing
else one can
do!
42 * This diverges from the standard
.
44 fun isslash c
= c
= #
"/" orelse (isWindows
andalso c
= #
"\\")
45 fun iscolon c
= c
= #
":"
48 (isWindows
andalso size v
= 2 andalso
49 Char.isAlpha (v sub
0) andalso iscolon (v sub
1))
51 fun volumeMatch (root
, relative
) =
53 orelse (isVolumeName root
54 andalso isVolumeName relative
55 andalso (Char.toUpper (root sub
0)
56 = Char.toUpper (relative sub
0)))
60 then String.translate (str
o Char.toLower
) a
66 (* Ahh joy
. The SML basis library standard
and Windows paths
.
68 * The big problem
with windows paths is
"\foo""
69 * - It's not absolute, since chdir("A
:\") may switch from
"C:", thus
70 * changing the meaning
of "\foo".
72 fun validVolume
{isAbs
, vol
} =
74 then isVolumeName vol
orelse (not isAbs
andalso vol
= "")
79 val (vol
, rest
) = (* 4:foo has a volume
of "4:" even tho invalid
*)
80 if isWindows
andalso size s
>= 2 andalso iscolon (s sub
1)
81 then (substring (s
, 0, SOME
2), substring (s
, 2, NONE
))
84 case (String.fields isslash rest
) of
85 "" :: [] => (false, [])
86 |
"" :: r
=> (true, r
)
89 {arcs
= arcs
, isAbs
= isAbs
, vol
= vol
}
92 val getVolume
= #vol
o fromString
93 val isAbsolute
= #isAbs
o fromString
94 val isRelative
= not
o isAbsolute
98 orelse (case fromString s
of
99 {arcs
= [_
], isAbs
= false, vol
= ""} => true
102 fun toString
{arcs
, isAbs
, vol
} =
103 if not (validVolume
{isAbs
= isAbs
, vol
= vol
})
105 else if not isAbs
andalso case arcs
of ("" :: _
) => true | _
=> false
107 else if List.exists (not
o isArc
) arcs
108 then raise InvalidArc
114 String.concatWith slash arcs
]
116 fun concatArcs (a1
, a2
) =
118 val a1
= case List.rev a1
of "" :: r
=> List.rev r | _
=> a1
123 fun concat (p1
, p2
) =
125 val {arcs
= a1
, isAbs
, vol
= v1
} = fromString p1
126 val {arcs
= a2
, isAbs
= isAbs2
, vol
= v2
} = fromString p2
128 if isAbs2
orelse not (volumeMatch (v1
, v2
))
130 else toString
{arcs
= concatArcs (a1
, a2
), isAbs
= isAbs
, vol
= v1
}
135 val {isAbs
, vol
, arcs
} = fromString p
137 List.rev (case List.rev arcs
of
139 |
"." :: r
=> parentArc
:: r
140 |
".." :: r
=> parentArc
:: parentArc
:: r
141 | _
:: [] => if isAbs
then [""] else [currentArc
]
142 |
"" :: r
=> parentArc
:: r
145 toString
{arcs
= arcs
, isAbs
= isAbs
, vol
= vol
}
150 val {arcs
, isAbs
, vol
} = fromString p
153 [] => if isAbs
then [] else [parentArc
]
156 then parentArc
:: parentArc
:: res
163 [] => if isAbs
then [""] else [currentArc
]
166 if a1
= "" orelse a1
= "."
169 then h (ar
, backup res
)
170 else h (ar
, canonName a1
:: res
)
175 toString
{arcs
= List.rev (reduce arcs
),
182 | _
:: ar
=> parentArc
:: parentize ar
184 fun mkRelative
{path
= p1
, relativeTo
= p2
} =
186 val {arcs
= arcs1
, isAbs
= isAbs1
, vol
= vol1
} = fromString p1
187 val {arcs
= arcs2
, isAbs
= isAbs2
, vol
= vol2
} =
188 fromString (mkCanonical p2
)
190 if not isAbs2
then raise Path
191 else if not isAbs1
then p1
198 |
([], a2
) => parentize a2
199 |
(a11
:: a1r
, a21
:: a2r
) =>
200 if canonName a11
= a21
then h (a1r
, a2r
)
201 else parentize a2 @
(if arcs1
= [""] then [] else a1
)
203 if not (volumeMatch (vol2
, vol1
))
205 else toString
{arcs
= h (arcs1
, arcs2
),
211 fun mkAbsolute
{path
= p1
, relativeTo
= p2
} =
212 if isRelative p2
then raise Path
213 else if isAbsolute p1
then p1
214 else mkCanonical (concat (p2
, p1
))
216 fun isCanonical p
= mkCanonical p
= p
218 fun joinDirFile
{dir
, file
} =
220 val {arcs
, isAbs
, vol
} = fromString dir
224 | _
=> concatArcs (arcs
, [file
])
226 toString
{arcs
= arcs
,
234 val {isAbs
, vol
, arcs
} = fromString p
237 [] => {dir
= p
, file
= ""}
239 {dir
= toString
{arcs
= rev farcs
, isAbs
= isAbs
, vol
= vol
},
244 val dir
= #dir
o splitDirFile
246 val file
= #file
o splitDirFile
248 fun joinBaseExt
{base
, ext
} =
253 else String.concat
[base
, ".", ex
]
257 val {dir
, file
} = splitDirFile s
259 val (fst
, snd
) = splitr (fn c
=> c
<> #
".") (full file
)
261 if isEmpty
snd (* dot at right
end *)
262 orelse isEmpty
fst (* no dot
*)
263 orelse size fst
= 1 (* dot at left
end only
*)
264 then {base
= s
, ext
= NONE
}
265 else {base
= joinDirFile
{dir
= dir
,
266 file
= string (trimr
1 fst
)},
267 ext
= SOME (string snd
)}
270 val ext
= #ext
o splitBaseExt
271 val base
= #base
o splitBaseExt
274 case fromString path
of
275 {isAbs
= true, arcs
=[""], ...} => true
279 if not isWindows
then s
280 else if Char.contains
s (slash sub
0) then raise InvalidArc
281 else String.translate (fn c
=> if c
= #
"/" then slash
else str c
) s
284 if not isWindows
then s
287 val {arcs
, isAbs
, vol
} = fromString s
291 else (if isAbs
then "/" else "") ^
String.concatWith
"/" arcs