Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/main/filename-policy.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/main/filename-policy.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 375, Wed Jul 7 03:08:04 1999 UTC revision 632, Sat Apr 29 15:50:42 2000 UTC
# Line 15  Line 15 
15    
16      val mkBinName : policy -> SrcPath.t -> string      val mkBinName : policy -> SrcPath.t -> string
17      val mkSkelName : policy -> SrcPath.t -> string      val mkSkelName : policy -> SrcPath.t -> string
18      val mkStableName : policy -> SrcPath.t -> string      val mkStableName : policy -> SrcPath.t * Version.t option -> string
19    
20      val kind2name : SMLofNJ.SysInfo.os_kind -> string      val kind2name : SMLofNJ.SysInfo.os_kind -> string
21  end  end
22    
23  functor FilenamePolicyFn (val cmdir : string  functor FilenamePolicyFn (val cmdir : string
24                              val versiondir: Version.t -> string
25                            val skeldir : string) :> FILENAMEPOLICY = struct                            val skeldir : string) :> FILENAMEPOLICY = struct
26    
27      type converter = SrcPath.t -> string      type policy = { bin: SrcPath.t -> string,
28                        skel: SrcPath.t -> string,
29                        stable: SrcPath.t * Version.t option -> string }
30    
     type policy = { bin: converter, skel: converter, stable: converter }  
31      type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy      type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
32    
33      fun kind2name SMLofNJ.SysInfo.BEOS = "beos"      fun kind2name SMLofNJ.SysInfo.BEOS = "beos"
# Line 34  Line 36 
36        | kind2name SMLofNJ.SysInfo.UNIX = "unix"        | kind2name SMLofNJ.SysInfo.UNIX = "unix"
37        | kind2name SMLofNJ.SysInfo.WIN32 = "win32"        | kind2name SMLofNJ.SysInfo.WIN32 = "win32"
38    
39      fun mkPolicy (shiftbin, shiftstable) { arch, os } = let      fun mkPolicy (shiftbin, shiftstable, ignoreversion) { arch, os } = let
40          fun cmname d s = let          fun cmname dl s = let
41              val { dir = d0, file = f } = OS.Path.splitDirFile s              val { dir = d0, file = f } = OS.Path.splitDirFile s
42              val d1 = OS.Path.joinDirFile { dir = d0, file = cmdir }              val d1 = OS.Path.joinDirFile { dir = d0, file = cmdir }
43              val d2 = OS.Path.joinDirFile { dir = d1, file = d }              fun subDir (sd, d) = OS.Path.joinDirFile { dir = d, file = sd }
44                val d2 = foldl subDir d1 dl
45          in          in
46              OS.Path.joinDirFile { dir = d2, file = f }              OS.Path.joinDirFile { dir = d2, file = f }
47          end          end
48          val archos = concat [arch, "-", kind2name os]          val archos = concat [arch, "-", kind2name os]
49            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      in
59          { skel = cmname skeldir o SrcPath.osstring,                           if exists then try else stable0 s
60            bin = cmname archos o shiftbin,                       end)
61            stable = cmname archos o shiftstable }      in
62            { skel = cmname [skeldir] o SrcPath.osstring,
63              bin = cmname [archos] o shiftbin,
64              stable = stable }
65      end      end
66    
67      val colocate = mkPolicy (SrcPath.osstring, SrcPath.osstring)      val colocate = mkPolicy (SrcPath.osstring, SrcPath.osstring, false)
68    
69      fun separate { bindir, bootdir } = let      fun separate { bindir, bootdir } = let
70          fun shiftname root p =          fun shiftname root p =
# Line 59  Line 74 
74                                    " is not an anchored path!\n"];                                    " is not an anchored path!\n"];
75                           raise Fail "bad path")                           raise Fail "bad path")
76      in      in
77          mkPolicy (shiftname bindir, shiftname bootdir)          mkPolicy (shiftname bindir, shiftname bootdir, true)
78      end      end
79    
80      fun mkBinName (p: policy) s = #bin p s      fun mkBinName (p: policy) s = #bin p s
81      fun mkSkelName (p: policy) s = #skel p s      fun mkSkelName (p: policy) s = #skel p s
82      fun mkStableName (p: policy) s = #stable p s      fun mkStableName (p: policy) (s, v) = #stable p (s, v)
83  end  end
84    
85  structure FilenamePolicy =  structure FilenamePolicy =
86      FilenamePolicyFn (val cmdir = "CM" val skeldir = "SKEL")      FilenamePolicyFn (val cmdir = "CM" val skeldir = "SKEL"
87                          val versiondir = Version.toString)

Legend:
Removed from v.375  
changed lines
  Added in v.632

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