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

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