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

Parent Directory | Revision Log | 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

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

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