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 354 - (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 : blume 354 val mkBinName : policy -> SrcPath.t -> string
17 :     val mkSkelName : policy -> SrcPath.t -> string
18 :     val mkStableName : policy -> SrcPath.t -> string
19 : blume 297 end
20 :    
21 : blume 331 functor FilenamePolicyFn (val cmdir : string
22 :     val skeldir : string) :> FILENAMEPOLICY = struct
23 : blume 297
24 : blume 354 type converter = SrcPath.t -> string
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 354 fun mkPolicy shiftname { arch, os } = let
36 :     fun cmname d s = let
37 :     val { dir = d0, file = f } = OS.Path.splitDirFile s
38 :     val d1 = OS.Path.joinDirFile { dir = d0, file = cmdir }
39 :     val d2 = OS.Path.joinDirFile { dir = d1, file = d }
40 : blume 329 in
41 : blume 354 OS.Path.joinDirFile { dir = d2, file = f }
42 : blume 329 end
43 : blume 322 val archos = concat [arch, "-", kind2name os]
44 : blume 354 val skel = cmname skeldir o SrcPath.osstring
45 :     val archosdep = cmname archos o shiftname
46 : blume 322 in
47 : blume 354 { skel = skel, bin = archosdep, stable = archosdep }
48 : blume 322 end
49 :    
50 : blume 354 val colocate = mkPolicy SrcPath.osstring
51 : blume 329
52 : blume 352 fun separate root = let
53 : blume 354 fun shiftname p =
54 :     case SrcPath.reAnchoredName (p, root) of
55 :     SOME s => s
56 :     | NONE => (Say.say ["Failure: ", SrcPath.descr p,
57 : blume 352 " is not an anchored path!\n"];
58 :     raise Fail "bad path")
59 : blume 322 in
60 : blume 354 mkPolicy shiftname
61 : blume 322 end
62 :    
63 : blume 354 fun mkBinName (p: policy) s = #bin p s
64 :     fun mkSkelName (p: policy) s = #skel p s
65 :     fun mkStableName (p: policy) s = #stable p s
66 : blume 297 end
67 : blume 331
68 :     structure FilenamePolicy =
69 :     FilenamePolicyFn (val cmdir = "NEWCM" val skeldir = "SKEL")

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