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/cm/paths/fileid.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/paths/fileid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 937 - (view) (download)

1 : blume 666 (*
2 :     * Abstract file IDs.
3 :     * - IDs for files regardless whether they exist or not.
4 :     * - For existing files equivalent to OS.FileSys.file_id.
5 :     *
6 :     * Copyright (c) 2000 by Lucent Technologies, Bell Laboratories
7 :     *
8 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
9 :     *)
10 :     signature FILEID = sig
11 :    
12 :     type id
13 :     type ord_key = id (* to be able to match ORD_KEY *)
14 :    
15 :     val compare : id * id -> order
16 :    
17 :     val fileId : string -> id
18 : blume 937
19 :     val canonical : string -> string
20 : blume 666 end
21 :    
22 :     structure FileId :> FILEID = struct
23 :    
24 :     structure F = OS.FileSys
25 :     structure P = OS.Path
26 :    
27 :     datatype id =
28 :     PRESENT of F.file_id
29 :     | ABSENT of string
30 :    
31 :     type ord_key = id
32 :    
33 :     fun compare (PRESENT fid, PRESENT fid') = F.compare (fid, fid')
34 :     | compare (ABSENT _, PRESENT _) = LESS
35 :     | compare (PRESENT _, ABSENT _) = GREATER
36 :     | compare (ABSENT s, ABSENT s') = String.compare (s, s')
37 :    
38 :     fun fileId f = let
39 : blume 735 (* To maximize our chances of recognizing equivalent path names to
40 : blume 666 * non-existing files, we use F.fullPath to expand the largest
41 :     * possible prefix of the path. *)
42 :     fun expandPath f = let
43 :     fun loop { dir, file } = P.concat (F.fullPath dir, file)
44 :     handle _ => let
45 :     val { dir = dir', file = file' } = P.splitDirFile dir
46 :     in
47 :     loop { dir = dir', file = P.concat (file', file) }
48 :     end
49 :     in
50 :     (* An initial call to splitDirFile is ok because we already know
51 :     * that the complete path does not refer to an existing file. *)
52 :     loop (P.splitDirFile f)
53 :     end
54 :     in
55 :     PRESENT (F.fileId f) handle _ => ABSENT (expandPath f)
56 :     end
57 : blume 937
58 :     fun canonical "" = ""
59 :     | canonical f =
60 :     if (F.access (f, []) handle _ => false) then
61 :     let val f' = P.mkCanonical f
62 :     in
63 :     if F.compare (F.fileId f, F.fileId f') = EQUAL then f'
64 :     else f
65 :     end
66 :     else
67 :     let val { dir, file } = P.splitDirFile f
68 :     in
69 :     P.joinDirFile { dir = canonical dir, file = file }
70 :     end
71 : blume 666 end

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