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

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