Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/PervEnv/Win32/os-path.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/PervEnv/Win32/os-path.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/PervEnv/Win32/os-path.sml

1 : monnier 16 (* os-path.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories.
4 :     *
5 :     * Win32 implementation of the OS.Path structure.
6 :     *
7 :     *)
8 :    
9 :     structure OS_Path = OS_PathFn (
10 :     struct
11 :     structure W32G = Win32_General
12 :     structure C = Char
13 :     structure S = String
14 :     structure SS = Substring
15 :    
16 :     exception Path
17 :    
18 :     datatype arc_kind = Null | Parent | Current | Arc of string
19 :    
20 :     fun classify "" = Null
21 :     | classify "." = Current
22 :     | classify ".." = Parent
23 :     | classify a = Arc a
24 :    
25 :     val parentArc = ".."
26 :     val currentArc = "."
27 :    
28 :     val volSepChar = #":"
29 :    
30 :     val arcSepChar = W32G.arcSepChar
31 :     val arcSep = S.str arcSepChar
32 :    
33 :     fun volPresent vol =
34 :     (String.size vol >= 2) andalso
35 :     (C.isAlpha(S.sub(vol,0)) andalso (S.sub(vol,1) = volSepChar))
36 :    
37 :     fun validVolume (_,vol) =
38 :     (SS.isEmpty vol) orelse volPresent(SS.string vol)
39 :    
40 :     val emptySS = SS.all ""
41 :    
42 :     fun splitPath (vol, s) =
43 :     if (SS.size s >= 1) andalso (SS.sub(s, 0) = arcSepChar) then
44 :     (true, vol, SS.triml 1 s)
45 :     else (false, vol, s)
46 :    
47 :     fun splitVolPath "" = (false, emptySS, emptySS)
48 :     | splitVolPath s =
49 :     if volPresent s then splitPath (SS.splitAt (SS.all s, 2))
50 :     else splitPath (emptySS, SS.all s)
51 :    
52 :     fun joinVolPath arg =
53 :     let fun checkVol vol = if (volPresent vol) then vol else raise Path
54 :     fun aux (true,"","") = arcSep
55 :     | aux (true,"",s) = arcSep^s
56 :     | aux (true,vol,"") = (checkVol vol)^arcSep
57 :     | aux (true,vol,s) = (checkVol vol)^arcSep^s
58 :     | aux (false,"",s) = s
59 :     | aux (false,vol,"") = checkVol vol
60 :     | aux (false,vol,s) = (checkVol vol)^s
61 :     in aux arg
62 :     end
63 :     end);
64 :    
65 :    
66 :    
67 :     (*
68 :     * $Log: os-path.sml,v $
69 :     * Revision 1.1.1.1 1997/01/14 01:38:26 george
70 :     * Version 109.24
71 :     *
72 :     *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0