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/smlnj-lib/Unix/unix-path.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-lib/Unix/unix-path.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (view) (download)
Original Path: sml/branches/SMLNJ/src/smlnj-lib/Unix/unix-path.sml

1 : monnier 2 (* unix-path.sml
2 :     *
3 :     * COPYRIGHT (c) 1991 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *
5 :     * AUTHOR: John Reppy
6 :     * AT&T Bell Laboratories
7 :     * Murray Hill, NJ 07974
8 :     * jhr@research.att.com
9 :     *)
10 :    
11 :     structure UnixPath : UNIX_PATH =
12 :     struct
13 :    
14 :     structure FS : sig
15 :     datatype access_mode = A_READ | A_WRITE | A_EXEC
16 :     end = OS.FileSys
17 :     open FS
18 :    
19 :     (** WHAT IS THIS IN POSIX??? **)
20 :     datatype file_type = F_REGULAR | F_DIR | F_SYMLINK | F_SOCK | F_CHR | F_BLK
21 :    
22 :    
23 :     (** Path lists **)
24 :    
25 :     datatype path_list = PathList of string list
26 :    
27 :     exception NoSuchFile
28 :    
29 :     fun getPath () = let
30 :     val path = (case (UnixEnv.getEnv "PATH") of (SOME p) => p | _ => "")
31 :     in
32 :     PathList(String.fields (fn #":" => true | _ => false) path)
33 :     end (* getPath *)
34 :    
35 :     local
36 :     fun getFileTy path = Posix.FileSys.ST.fileType(Posix.FileSys.stat path)
37 :     fun isFileTy (path, F_REGULAR) = Posix.FileSys.isReg(getFileTy path)
38 :     | isFileTy (path, F_DIR) = Posix.FileSys.isDir(getFileTy path)
39 :     | isFileTy (path, F_SYMLINK) = Posix.FileSys.isLink(getFileTy path)
40 :     | isFileTy (path, F_SOCK) = Posix.FileSys.isSock(getFileTy path)
41 :     | isFileTy (path, F_CHR) = Posix.FileSys.isChr(getFileTy path)
42 :     | isFileTy (path, F_BLK) = Posix.FileSys.isBlk(getFileTy path)
43 :     fun access mode pathname = (OS.FileSys.access(pathname, mode))
44 :     fun accessAndType (mode, ftype) pathname = (
45 :     OS.FileSys.access(pathname, mode)
46 :     andalso isFileTy(pathname, ftype))
47 :     handle _ => false
48 :     (* return the first path p in the pathlist, such that p/name satisfies
49 :     * the predicate.
50 :     *)
51 :     fun findFile' (PathList l, pred) fname = let
52 :     fun find [] = raise NoSuchFile
53 :     | find (p::r) = let val pn = OS.Path.joinDirFile{dir=p, file=fname}
54 :     in
55 :     if (pred pn) then pn else find r
56 :     end
57 :     in
58 :     if (OS.Path.isAbsolute fname)
59 :     then if (pred fname) then fname else raise NoSuchFile
60 :     else find l
61 :     end
62 :     (* return the list of paths p in the pathlist, such that p/name satisfies
63 :     * the predicate.
64 :     *)
65 :     fun findFiles' (PathList l, pred) fname = let
66 :     fun find ([], l) = rev l
67 :     | find (p::r, l) = let val pn = OS.Path.joinDirFile{dir=p, file=fname}
68 :     in
69 :     if (pred pn) then find (r, pn::l) else find (r, l)
70 :     end
71 :     in
72 :     if (OS.Path.isAbsolute fname)
73 :     then if (pred fname) then [fname] else []
74 :     else find (l, [])
75 :     end
76 :     in
77 :     fun findFile (pl, mode) = findFile' (pl, access mode)
78 :     fun findFiles (pl, mode) = findFiles' (pl, access mode)
79 :     fun findFileOfType (pl, ftype, mode) =
80 :     findFile' (pl, accessAndType(mode, ftype))
81 :     fun findFilesOfType (pl, ftype, mode) =
82 :     findFiles' (pl, accessAndType(mode, ftype))
83 :     end (* local *)
84 :    
85 :     end (* UnixPath *)

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