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

Parent Directory | Revision Log

---

Revision 322 - (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 :
12 :	blume	322	val colocate :
13 :			{ arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
14 :			val separate :
15 :			{ root: AbsPath.t, parentArc: string, absArc: string } -> policy
16 :	blume	297
17 :			val mkBinPath : policy -> AbsPath.t -> AbsPath.t
18 :			val mkSkelPath : policy -> AbsPath.t -> AbsPath.t
19 :			val mkStablePath : policy -> AbsPath.t -> AbsPath.t
20 :			end
21 :
22 :			structure FilenamePolicy :> FILENAMEPOLICY = struct
23 :
24 :	blume	322	type converter = AbsPath.t -> AbsPath.t
25 :	blume	297
26 :	blume	322	type policy = { bin: converter, skel: converter, stable: converter }
27 :	blume	297
28 :	blume	322	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
35 :	blume	297	val { dir = d0, file = f } = AbsPath.splitDirFile s
36 :			val d1 = AbsPath.joinDirFile { dir = d0, file = "CM" }
37 :			val d2 = AbsPath.joinDirFile { dir = d1, file = d }
38 :			in
39 :			AbsPath.joinDirFile { dir = d2, file = f }
40 :			end
41 :
42 :	blume	322	fun colocate { arch, os } = let
43 :			val archos = concat [arch, "-", kind2name os]
44 :			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 :	blume	297	end

---

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