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 632 - (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 357 val separate : { bindir: string, bootdir: string } -> policyMaker
15 : blume 297
16 : blume 354 val mkBinName : policy -> SrcPath.t -> string
17 :     val mkSkelName : policy -> SrcPath.t -> string
18 : blume 632 val mkStableName : policy -> SrcPath.t * Version.t option -> string
19 : blume 357
20 :     val kind2name : SMLofNJ.SysInfo.os_kind -> string
21 : blume 297 end
22 :    
23 : blume 331 functor FilenamePolicyFn (val cmdir : string
24 : blume 632 val versiondir: Version.t -> string
25 : blume 331 val skeldir : string) :> FILENAMEPOLICY = struct
26 : blume 297
27 : blume 632 type policy = { bin: SrcPath.t -> string,
28 :     skel: SrcPath.t -> string,
29 :     stable: SrcPath.t * Version.t option -> string }
30 : blume 297
31 : blume 329 type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
32 : blume 297
33 : blume 322 fun kind2name SMLofNJ.SysInfo.BEOS = "beos"
34 :     | kind2name SMLofNJ.SysInfo.MACOS = "macos"
35 :     | kind2name SMLofNJ.SysInfo.OS2 = "os2"
36 :     | kind2name SMLofNJ.SysInfo.UNIX = "unix"
37 :     | kind2name SMLofNJ.SysInfo.WIN32 = "win32"
38 :    
39 : blume 632 fun mkPolicy (shiftbin, shiftstable, ignoreversion) { arch, os } = let
40 :     fun cmname dl s = let
41 : blume 354 val { dir = d0, file = f } = OS.Path.splitDirFile s
42 :     val d1 = OS.Path.joinDirFile { dir = d0, file = cmdir }
43 : blume 632 fun subDir (sd, d) = OS.Path.joinDirFile { dir = d, file = sd }
44 :     val d2 = foldl subDir d1 dl
45 : blume 329 in
46 : blume 354 OS.Path.joinDirFile { dir = d2, file = f }
47 : blume 329 end
48 : blume 322 val archos = concat [arch, "-", kind2name os]
49 : blume 632 val stable0 = cmname [archos] o shiftstable
50 :     val stable =
51 :     if ignoreversion then stable0 o #1
52 :     else (fn (s, NONE) => stable0 s
53 :     | (s, SOME v) => let
54 :     val try =
55 :     cmname [versiondir v, archos] (shiftstable s)
56 :     val exists =
57 :     OS.FileSys.access (try, []) handle _ => false
58 :     in
59 :     if exists then try else stable0 s
60 :     end)
61 : blume 322 in
62 : blume 632 { skel = cmname [skeldir] o SrcPath.osstring,
63 :     bin = cmname [archos] o shiftbin,
64 :     stable = stable }
65 : blume 322 end
66 :    
67 : blume 632 val colocate = mkPolicy (SrcPath.osstring, SrcPath.osstring, false)
68 : blume 329
69 : blume 357 fun separate { bindir, bootdir } = let
70 :     fun shiftname root p =
71 : blume 354 case SrcPath.reAnchoredName (p, root) of
72 :     SOME s => s
73 :     | NONE => (Say.say ["Failure: ", SrcPath.descr p,
74 : blume 352 " is not an anchored path!\n"];
75 :     raise Fail "bad path")
76 : blume 322 in
77 : blume 632 mkPolicy (shiftname bindir, shiftname bootdir, true)
78 : blume 322 end
79 :    
80 : blume 354 fun mkBinName (p: policy) s = #bin p s
81 :     fun mkSkelName (p: policy) s = #skel p s
82 : blume 632 fun mkStableName (p: policy) (s, v) = #stable p (s, v)
83 : blume 297 end
84 : blume 331
85 :     structure FilenamePolicy =
86 : blume 632 FilenamePolicyFn (val cmdir = "CM" val skeldir = "SKEL"
87 :     val versiondir = Version.toString)

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