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

Parent Directory | Revision Log

---

Revision 329 - (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 :	blume	329	type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
12 :	blume	297
13 :	blume	329	val colocate : policyMaker
14 :	blume	322	val separate :
15 :	blume	329	{ root: AbsPath.t, parentArc: string, absArc: string } -> policyMaker
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	329	type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
28 :	blume	297
29 :	blume	322	fun kind2name SMLofNJ.SysInfo.BEOS = "beos"
30 :			| kind2name SMLofNJ.SysInfo.MACOS = "macos"
31 :			| kind2name SMLofNJ.SysInfo.OS2 = "os2"
32 :			| kind2name SMLofNJ.SysInfo.UNIX = "unix"
33 :			| kind2name SMLofNJ.SysInfo.WIN32 = "win32"
34 :
35 :	blume	329	fun mkPolicy shift { arch, os } = let
36 :			fun cmpath d s = let
37 :			val { dir = d0, file = f } = AbsPath.splitDirFile s
38 :			val d1 = AbsPath.joinDirFile { dir = d0, file = "CM" }
39 :			val d2 = AbsPath.joinDirFile { dir = d1, file = d }
40 :			in
41 :			AbsPath.joinDirFile { dir = d2, file = f }
42 :			end
43 :	blume	322	val archos = concat [arch, "-", kind2name os]
44 :	blume	329	val archosdep = cmpath archos o shift
45 :	blume	322	in
46 :	blume	329	{ skel = cmpath "SKEL", bin = archosdep, stable = archosdep }
47 :	blume	322	end
48 :
49 :	blume	329	val colocate = mkPolicy (fn s => s)
50 :
51 :	blume	322	fun separate { root, parentArc, absArc } = let
52 :	blume	329	val root = AbsPath.relativeContext root
53 :			fun shift p = let
54 :	blume	322	val s = AbsPath.name p
55 :			fun cvt arc = if arc = OS.Path.parentArc then parentArc else arc
56 :			in
57 :			case OS.Path.fromString s of
58 :			{ isAbs = false, vol = "", arcs } =>
59 :			AbsPath.native { context = root,
60 :			spec = OS.Path.toString
61 :			{ isAbs = false, vol = "",
62 :			arcs = map cvt arcs } }
63 :			| _ => AbsPath.native
64 :			{ context = root,
65 :			spec = OS.Path.joinDirFile { dir = absArc,
66 :			file = AbsPath.file p } }
67 :			end
68 :			in
69 :	blume	329	mkPolicy shift
70 :	blume	322	end
71 :
72 :			fun mkBinPath (p: policy) s = #bin p s
73 :			fun mkSkelPath (p: policy) s = #skel p s
74 :			fun mkStablePath (p: policy) s = #stable p s
75 :	blume	297	end

---

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