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 353 - (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 353 val separate : string -> policyMaker
15 : blume 297
16 :     val mkBinPath : policy -> AbsPath.t -> AbsPath.t
17 :     val mkSkelPath : policy -> AbsPath.t -> AbsPath.t
18 :     val mkStablePath : policy -> AbsPath.t -> AbsPath.t
19 :     end
20 :    
21 : blume 331 functor FilenamePolicyFn (val cmdir : string
22 :     val skeldir : string) :> FILENAMEPOLICY = struct
23 : blume 297
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 : blume 331 val d1 = AbsPath.joinDirFile { dir = d0, file = cmdir }
39 : blume 329 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 331 { skel = cmpath skeldir, bin = archosdep, stable = archosdep }
47 : blume 322 end
48 :    
49 : blume 352 val colocate = mkPolicy (fn p => p)
50 : blume 329
51 : blume 352 fun separate root = let
52 :     fun shift p =
53 :     case AbsPath.reAnchor (p, root) of
54 :     SOME p' => p'
55 :     | NONE => (Say.say ["Failure: ", AbsPath.name p,
56 :     " is not an anchored path!\n"];
57 :     raise Fail "bad path")
58 : blume 322 in
59 : blume 329 mkPolicy shift
60 : blume 322 end
61 :    
62 :     fun mkBinPath (p: policy) s = #bin p s
63 :     fun mkSkelPath (p: policy) s = #skel p s
64 :     fun mkStablePath (p: policy) s = #stable p s
65 : blume 297 end
66 : blume 331
67 :     structure FilenamePolicy =
68 :     FilenamePolicyFn (val cmdir = "NEWCM" val skeldir = "SKEL")

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