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 297, Thu May 27 08:29:19 1999 UTC revision 322, Tue Jun 8 09:36:16 1999 UTC
# Line 1  Line 1 
 (* just a placeholder so far *)  
   
1  (*  (*
2   * A type representing different choices for file naming conventions.   * A type representing different choices for file naming conventions.
3   *   *
# Line 11  Line 9 
9    
10      type policy      type policy
11    
12      val default : policy      val colocate :
13            { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
14        val separate :
15            { root: AbsPath.t, parentArc: string, absArc: string } -> policy
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 20  Line 21 
21    
22  structure FilenamePolicy :> FILENAMEPOLICY = struct  structure FilenamePolicy :> FILENAMEPOLICY = struct
23    
24      type policy = Dummy.t      type converter = AbsPath.t -> AbsPath.t
25    
26        type policy = { bin: converter, skel: converter, stable: converter }
27    
28      val default = Dummy.v      fun kind2name SMLofNJ.SysInfo.BEOS = "beos"
29          | kind2name SMLofNJ.SysInfo.MACOS = "macos"
30          | kind2name SMLofNJ.SysInfo.OS2 = "os2"
31          | kind2name SMLofNJ.SysInfo.UNIX = "unix"
32          | kind2name SMLofNJ.SysInfo.WIN32 = "win32"
33    
34      fun cmpath (d, s) = let      fun cmpath d s = let
35          val { dir = d0, file = f } = AbsPath.splitDirFile s          val { dir = d0, file = f } = AbsPath.splitDirFile s
36          val d1 = AbsPath.joinDirFile { dir = d0, file = "CM" }          val d1 = AbsPath.joinDirFile { dir = d0, file = "CM" }
37          val d2 = AbsPath.joinDirFile { dir = d1, file = d }          val d2 = AbsPath.joinDirFile { dir = d1, file = d }
# Line 32  Line 39 
39          AbsPath.joinDirFile { dir = d2, file = f }          AbsPath.joinDirFile { dir = d2, file = f }
40      end      end
41    
42      fun mkBinPath _ s = cmpath ("bin", s)      fun colocate { arch, os } = let
43      fun mkSkelPath _ s = cmpath ("SKEL", s)          val archos = concat [arch, "-", kind2name os]
44      fun mkStablePath _ s = cmpath ("bin", s)      in
45            { skel = cmpath "SKEL", bin = cmpath archos, stable = cmpath archos }
46        end
47    
48        fun separate { root, parentArc, absArc } = let
49            val root = AbsPath.context root
50            fun sep p = let
51                val s = AbsPath.name p
52                fun cvt arc = if arc = OS.Path.parentArc then parentArc else arc
53            in
54                case OS.Path.fromString s of
55                    { isAbs = false, vol = "", arcs } =>
56                        AbsPath.native { context = root,
57                                         spec = OS.Path.toString
58                                             { isAbs = false, vol = "",
59                                               arcs = map cvt arcs } }
60                  | _ => AbsPath.native
61                        { context = root,
62                          spec = OS.Path.joinDirFile { dir = absArc,
63                                                       file = AbsPath.file p } }
64            end
65        in
66            { skel = cmpath "SKEL", bin = sep, stable = sep }
67        end
68    
69        fun mkBinPath (p: policy) s = #bin p s
70        fun mkSkelPath (p: policy) s = #skel p s
71        fun mkStablePath (p: policy) s = #stable p s
72  end  end

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

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