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 331, Sat Jun 12 15:04:53 1999 UTC revision 354, Fri Jun 25 08:36:12 1999 UTC
# Line 11  Line 11 
11      type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy      type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
12    
13      val colocate : policyMaker      val colocate : policyMaker
14      val separate :      val separate : string -> policyMaker
         { root: AbsPath.t, parentArc: string, absArc: string } -> policyMaker  
15    
16      val mkBinPath : policy -> AbsPath.t -> AbsPath.t      val mkBinName : policy -> SrcPath.t -> string
17      val mkSkelPath : policy -> AbsPath.t -> AbsPath.t      val mkSkelName : policy -> SrcPath.t -> string
18      val mkStablePath : policy -> AbsPath.t -> AbsPath.t      val mkStableName : policy -> SrcPath.t -> string
19  end  end
20    
21  functor FilenamePolicyFn (val cmdir : string  functor FilenamePolicyFn (val cmdir : string
22                            val skeldir : string) :> FILENAMEPOLICY = struct                            val skeldir : string) :> FILENAMEPOLICY = struct
23    
24      type converter = AbsPath.t -> AbsPath.t      type converter = SrcPath.t -> string
25    
26      type policy = { bin: converter, skel: converter, stable: converter }      type policy = { bin: converter, skel: converter, stable: converter }
27      type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy      type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
# Line 33  Line 32 
32        | kind2name SMLofNJ.SysInfo.UNIX = "unix"        | kind2name SMLofNJ.SysInfo.UNIX = "unix"
33        | kind2name SMLofNJ.SysInfo.WIN32 = "win32"        | kind2name SMLofNJ.SysInfo.WIN32 = "win32"
34    
35      fun mkPolicy shift { arch, os } = let      fun mkPolicy shiftname { arch, os } = let
36          fun cmpath d s = let          fun cmname d s = let
37              val { dir = d0, file = f } = AbsPath.splitDirFile s              val { dir = d0, file = f } = OS.Path.splitDirFile s
38              val d1 = AbsPath.joinDirFile { dir = d0, file = cmdir }              val d1 = OS.Path.joinDirFile { dir = d0, file = cmdir }
39              val d2 = AbsPath.joinDirFile { dir = d1, file = d }              val d2 = OS.Path.joinDirFile { dir = d1, file = d }
40          in          in
41              AbsPath.joinDirFile { dir = d2, file = f }              OS.Path.joinDirFile { dir = d2, file = f }
42          end          end
43          val archos = concat [arch, "-", kind2name os]          val archos = concat [arch, "-", kind2name os]
44          val archosdep = cmpath archos o shift          val skel = cmname skeldir o SrcPath.osstring
45            val archosdep = cmname archos o shiftname
46      in      in
47          { skel = cmpath skeldir, bin = archosdep, stable = archosdep }          { skel = skel, bin = archosdep, stable = archosdep }
48      end      end
49    
50      val colocate = mkPolicy (fn s => s)      val colocate = mkPolicy SrcPath.osstring
51    
52      fun separate { root, parentArc, absArc } = let      fun separate root = let
53          val root = AbsPath.relativeContext root          fun shiftname p =
54          fun shift p = let              case SrcPath.reAnchoredName (p, root) of
55              val s = AbsPath.name p                  SOME s => s
56              fun cvt arc = if arc = OS.Path.parentArc then parentArc else arc                | NONE => (Say.say ["Failure: ", SrcPath.descr p,
57                                      " is not an anchored path!\n"];
58                             raise Fail "bad path")
59          in          in
60              case OS.Path.fromString s of          mkPolicy shiftname
                 { isAbs = false, vol = "", arcs } =>  
                     AbsPath.native { context = root,  
                                      spec = OS.Path.toString  
                                          { isAbs = false, vol = "",  
                                            arcs = map cvt arcs } }  
               | _ => AbsPath.native  
                     { context = root,  
                       spec = OS.Path.joinDirFile { dir = absArc,  
                                                    file = AbsPath.file p } }  
         end  
     in  
         mkPolicy shift  
61      end      end
62    
63      fun mkBinPath (p: policy) s = #bin p s      fun mkBinName (p: policy) s = #bin p s
64      fun mkSkelPath (p: policy) s = #skel p s      fun mkSkelName (p: policy) s = #skel p s
65      fun mkStablePath (p: policy) s = #stable p s      fun mkStableName (p: policy) s = #stable p s
66  end  end
67    
68  structure FilenamePolicy =  structure FilenamePolicy =

Legend:
Removed from v.331  
changed lines
  Added in v.354

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