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

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