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 329 - (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 : blume 329 type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
12 : blume 297
13 : blume 329 val colocate : policyMaker
14 : blume 322 val separate :
15 : blume 329 { root: AbsPath.t, parentArc: string, absArc: string } -> policyMaker
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 329 type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
28 : blume 297
29 : blume 322 fun kind2name SMLofNJ.SysInfo.BEOS = "beos"
30 :     | kind2name SMLofNJ.SysInfo.MACOS = "macos"
31 :     | kind2name SMLofNJ.SysInfo.OS2 = "os2"
32 :     | kind2name SMLofNJ.SysInfo.UNIX = "unix"
33 :     | kind2name SMLofNJ.SysInfo.WIN32 = "win32"
34 :    
35 : blume 329 fun mkPolicy shift { arch, os } = let
36 :     fun cmpath d s = let
37 :     val { dir = d0, file = f } = AbsPath.splitDirFile s
38 :     val d1 = AbsPath.joinDirFile { dir = d0, file = "CM" }
39 :     val d2 = AbsPath.joinDirFile { dir = d1, file = d }
40 :     in
41 :     AbsPath.joinDirFile { dir = d2, file = f }
42 :     end
43 : blume 322 val archos = concat [arch, "-", kind2name os]
44 : blume 329 val archosdep = cmpath archos o shift
45 : blume 322 in
46 : blume 329 { skel = cmpath "SKEL", bin = archosdep, stable = archosdep }
47 : blume 322 end
48 :    
49 : blume 329 val colocate = mkPolicy (fn s => s)
50 :    
51 : blume 322 fun separate { root, parentArc, absArc } = let
52 : blume 329 val root = AbsPath.relativeContext root
53 :     fun shift p = let
54 : blume 322 val s = AbsPath.name p
55 :     fun cvt arc = if arc = OS.Path.parentArc then parentArc else arc
56 :     in
57 :     case OS.Path.fromString s of
58 :     { isAbs = false, vol = "", arcs } =>
59 :     AbsPath.native { context = root,
60 :     spec = OS.Path.toString
61 :     { isAbs = false, vol = "",
62 :     arcs = map cvt arcs } }
63 :     | _ => AbsPath.native
64 :     { context = root,
65 :     spec = OS.Path.joinDirFile { dir = absArc,
66 :     file = AbsPath.file p } }
67 :     end
68 :     in
69 : blume 329 mkPolicy shift
70 : blume 322 end
71 :    
72 :     fun mkBinPath (p: policy) s = #bin p s
73 :     fun mkSkelPath (p: policy) s = #skel p s
74 :     fun mkStablePath (p: policy) s = #stable p s
75 : blume 297 end

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