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

Parent Directory | Revision Log | Patch

	revision 297, Thu May 27 08:29:19 1999 UTC	revision 352, Wed Jun 23 09:27:27 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 10	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 default : policy	val colocate : policyMaker
14		val separate : AbsPath.t -> policyMaker
15
16	val mkBinPath : policy -> AbsPath.t -> AbsPath.t	val mkBinPath : policy -> AbsPath.t -> AbsPath.t
17	val mkSkelPath : policy -> AbsPath.t -> AbsPath.t	val mkSkelPath : policy -> AbsPath.t -> AbsPath.t
18	val mkStablePath : policy -> AbsPath.t -> AbsPath.t	val mkStablePath : policy -> AbsPath.t -> AbsPath.t
19	end	end
20
21	structure FilenamePolicy :> FILENAMEPOLICY = struct	functor FilenamePolicyFn (val cmdir : string
22		val skeldir : string) :> FILENAMEPOLICY = struct
23
24		type converter = AbsPath.t -> AbsPath.t
25
26	type policy = Dummy.t	type policy = { bin: converter, skel: converter, stable: converter }
27		type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
28
29	val default = Dummy.v	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	fun cmpath (d, s) = let	fun mkPolicy shift { arch, os } = let
36		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 = cmdir }
39	val d2 = AbsPath.joinDirFile { dir = d1, file = d }	val d2 = AbsPath.joinDirFile { dir = d1, file = d }
40	in	in
41	AbsPath.joinDirFile { dir = d2, file = f }	AbsPath.joinDirFile { dir = d2, file = f }
42	end	end
43		val archos = concat [arch, "-", kind2name os]
44		val archosdep = cmpath archos o shift
45		in
46		{ skel = cmpath skeldir, bin = archosdep, stable = archosdep }
47		end
48
49		val colocate = mkPolicy (fn p => p)
50
51	fun mkBinPath _ s = cmpath ("bin", s)	fun separate root = let
52	fun mkSkelPath _ s = cmpath ("SKEL", s)	val root = AbsPath.relativeContext root
53	fun mkStablePath _ s = cmpath ("bin", s)	fun shift p =
54		case AbsPath.reAnchor (p, root) of
55		SOME p' => p'
56		| NONE => (Say.say ["Failure: ", AbsPath.name p,
57		" is not an anchored path!\n"];
58		raise Fail "bad path")
59		in
60		mkPolicy shift
61		end
62
63		fun mkBinPath (p: policy) s = #bin p s
64		fun mkSkelPath (p: policy) s = #skel p s
65		fun mkStablePath (p: policy) s = #stable p s
66	end	end
67
68		structure FilenamePolicy =
69		FilenamePolicyFn (val cmdir = "NEWCM" val skeldir = "SKEL")

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

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

---

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