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 322, Tue Jun 8 09:36:16 1999 UTC revision 329, Fri Jun 11 09:53:10 1999 UTC
# Line 8  Line 8 
8  signature FILENAMEPOLICY = sig  signature FILENAMEPOLICY = sig
9    
10      type policy      type policy
11        type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
12    
13      val colocate :      val colocate : policyMaker
         { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy  
14      val separate :      val separate :
15          { root: AbsPath.t, parentArc: string, absArc: string } -> policy          { root: AbsPath.t, parentArc: string, absArc: string } -> policyMaker
16    
17      val mkBinPath : policy -> AbsPath.t -> AbsPath.t      val mkBinPath : policy -> AbsPath.t -> AbsPath.t
18      val mkSkelPath : policy -> AbsPath.t -> AbsPath.t      val mkSkelPath : policy -> AbsPath.t -> AbsPath.t
# Line 24  Line 24 
24      type converter = AbsPath.t -> AbsPath.t      type converter = AbsPath.t -> AbsPath.t
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
28    
29      fun kind2name SMLofNJ.SysInfo.BEOS = "beos"      fun kind2name SMLofNJ.SysInfo.BEOS = "beos"
30        | kind2name SMLofNJ.SysInfo.MACOS = "macos"        | kind2name SMLofNJ.SysInfo.MACOS = "macos"
# Line 31  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
36      fun cmpath d s = let      fun cmpath d s = let
37          val { dir = d0, file = f } = AbsPath.splitDirFile s          val { dir = d0, file = f } = AbsPath.splitDirFile s
38          val d1 = AbsPath.joinDirFile { dir = d0, file = "CM" }          val d1 = AbsPath.joinDirFile { dir = d0, file = "CM" }
# Line 38  Line 40 
40      in      in
41          AbsPath.joinDirFile { dir = d2, file = f }          AbsPath.joinDirFile { dir = d2, file = f }
42      end      end
   
     fun colocate { arch, os } = let  
43          val archos = concat [arch, "-", kind2name os]          val archos = concat [arch, "-", kind2name os]
44            val archosdep = cmpath archos o shift
45      in      in
46          { skel = cmpath "SKEL", bin = cmpath archos, stable = cmpath archos }          { skel = cmpath "SKEL", bin = archosdep, stable = archosdep }
47      end      end
48    
49        val colocate = mkPolicy (fn s => s)
50    
51      fun separate { root, parentArc, absArc } = let      fun separate { root, parentArc, absArc } = let
52          val root = AbsPath.context root          val root = AbsPath.relativeContext root
53          fun sep p = let          fun shift p = let
54              val s = AbsPath.name p              val s = AbsPath.name p
55              fun cvt arc = if arc = OS.Path.parentArc then parentArc else arc              fun cvt arc = if arc = OS.Path.parentArc then parentArc else arc
56          in          in
# Line 63  Line 66 
66                                                     file = AbsPath.file p } }                                                     file = AbsPath.file p } }
67          end          end
68      in      in
69          { skel = cmpath "SKEL", bin = sep, stable = sep }          mkPolicy shift
70      end      end
71    
72      fun mkBinPath (p: policy) s = #bin p s      fun mkBinPath (p: policy) s = #bin p s

Legend:
Removed from v.322  
changed lines
  Added in v.329

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