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/main/filename-policy.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/main/filename-policy.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 322 - (view) (download)

1 : blume 297 (*
2 :     * A type representing different choices for file naming conventions.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 :     signature FILENAMEPOLICY = sig
9 :    
10 :     type policy
11 :    
12 : blume 322 val colocate :
13 :     { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
14 :     val separate :
15 :     { root: AbsPath.t, parentArc: string, absArc: string } -> policy
16 : blume 297
17 :     val mkBinPath : policy -> AbsPath.t -> AbsPath.t
18 :     val mkSkelPath : policy -> AbsPath.t -> AbsPath.t
19 :     val mkStablePath : policy -> AbsPath.t -> AbsPath.t
20 :     end
21 :    
22 :     structure FilenamePolicy :> FILENAMEPOLICY = struct
23 :    
24 : blume 322 type converter = AbsPath.t -> AbsPath.t
25 : blume 297
26 : blume 322 type policy = { bin: converter, skel: converter, stable: converter }
27 : blume 297
28 : blume 322 fun kind2name SMLofNJ.SysInfo.BEOS = "beos"
29 :     | kind2name SMLofNJ.SysInfo.MACOS = "macos"
30 :     | kind2name SMLofNJ.SysInfo.OS2 = "os2"
31 :     | kind2name SMLofNJ.SysInfo.UNIX = "unix"
32 :     | kind2name SMLofNJ.SysInfo.WIN32 = "win32"
33 :    
34 :     fun cmpath d s = let
35 : blume 297 val { dir = d0, file = f } = AbsPath.splitDirFile s
36 :     val d1 = AbsPath.joinDirFile { dir = d0, file = "CM" }
37 :     val d2 = AbsPath.joinDirFile { dir = d1, file = d }
38 :     in
39 :     AbsPath.joinDirFile { dir = d2, file = f }
40 :     end
41 :    
42 : blume 322 fun colocate { arch, os } = let
43 :     val archos = concat [arch, "-", kind2name os]
44 :     in
45 :     { skel = cmpath "SKEL", bin = cmpath archos, stable = cmpath archos }
46 :     end
47 :    
48 :     fun separate { root, parentArc, absArc } = let
49 :     val root = AbsPath.context root
50 :     fun sep p = let
51 :     val s = AbsPath.name p
52 :     fun cvt arc = if arc = OS.Path.parentArc then parentArc else arc
53 :     in
54 :     case OS.Path.fromString s of
55 :     { isAbs = false, vol = "", arcs } =>
56 :     AbsPath.native { context = root,
57 :     spec = OS.Path.toString
58 :     { isAbs = false, vol = "",
59 :     arcs = map cvt arcs } }
60 :     | _ => AbsPath.native
61 :     { context = root,
62 :     spec = OS.Path.joinDirFile { dir = absArc,
63 :     file = AbsPath.file p } }
64 :     end
65 :     in
66 :     { skel = cmpath "SKEL", bin = sep, stable = sep }
67 :     end
68 :    
69 :     fun mkBinPath (p: policy) s = #bin p s
70 :     fun mkSkelPath (p: policy) s = #skel p s
71 :     fun mkStablePath (p: policy) s = #stable p s
72 : blume 297 end

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