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

Parent Directory | Revision Log | Patch

	revision 631, Fri Apr 28 08:30:52 2000 UTC	revision 632, Sat Apr 29 15:50:42 2000 UTC
#	Line 15	Line 15
15
16	val mkBinName : policy -> SrcPath.t -> string	val mkBinName : policy -> SrcPath.t -> string
17	val mkSkelName : policy -> SrcPath.t -> string	val mkSkelName : policy -> SrcPath.t -> string
18	val mkStableName : policy -> SrcPath.t -> string	val mkStableName : policy -> SrcPath.t * Version.t option -> string
19
20	val kind2name : SMLofNJ.SysInfo.os_kind -> string	val kind2name : SMLofNJ.SysInfo.os_kind -> string
21	end	end
22
23	functor FilenamePolicyFn (val cmdir : string	functor FilenamePolicyFn (val cmdir : string
24		val versiondir: Version.t -> string
25	val skeldir : string) :> FILENAMEPOLICY = struct	val skeldir : string) :> FILENAMEPOLICY = struct
26
27	type converter = SrcPath.t -> string	type policy = { bin: SrcPath.t -> string,
28		skel: SrcPath.t -> string,
29		stable: SrcPath.t * Version.t option -> string }
30
	type policy = { bin: converter, skel: converter, stable: converter }
31	type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy	type policyMaker = { arch: string, os: SMLofNJ.SysInfo.os_kind } -> policy
32
33	fun kind2name SMLofNJ.SysInfo.BEOS = "beos"	fun kind2name SMLofNJ.SysInfo.BEOS = "beos"
#	Line 34	Line 36
36	| kind2name SMLofNJ.SysInfo.UNIX = "unix"	| kind2name SMLofNJ.SysInfo.UNIX = "unix"
37	| kind2name SMLofNJ.SysInfo.WIN32 = "win32"	| kind2name SMLofNJ.SysInfo.WIN32 = "win32"
38
39	fun mkPolicy (shiftbin, shiftstable) { arch, os } = let	fun mkPolicy (shiftbin, shiftstable, ignoreversion) { arch, os } = let
40	fun cmname d s = let	fun cmname dl s = let
41	val { dir = d0, file = f } = OS.Path.splitDirFile s	val { dir = d0, file = f } = OS.Path.splitDirFile s
42	val d1 = OS.Path.joinDirFile { dir = d0, file = cmdir }	val d1 = OS.Path.joinDirFile { dir = d0, file = cmdir }
43	val d2 = OS.Path.joinDirFile { dir = d1, file = d }	fun subDir (sd, d) = OS.Path.joinDirFile { dir = d, file = sd }
44		val d2 = foldl subDir d1 dl
45	in	in
46	OS.Path.joinDirFile { dir = d2, file = f }	OS.Path.joinDirFile { dir = d2, file = f }
47	end	end
48	val archos = concat [arch, "-", kind2name os]	val archos = concat [arch, "-", kind2name os]
49		val stable0 = cmname [archos] o shiftstable
50		val stable =
51		if ignoreversion then stable0 o #1
52		else (fn (s, NONE) => stable0 s
53		| (s, SOME v) => let
54		val try =
55		cmname [versiondir v, archos] (shiftstable s)
56		val exists =
57		OS.FileSys.access (try, []) handle _ => false
58	in	in
59	{ skel = cmname skeldir o SrcPath.osstring,	if exists then try else stable0 s
60	bin = cmname archos o shiftbin,	end)
61	stable = cmname archos o shiftstable }	in
62		{ skel = cmname [skeldir] o SrcPath.osstring,
63		bin = cmname [archos] o shiftbin,
64		stable = stable }
65	end	end
66
67	val colocate = mkPolicy (SrcPath.osstring, SrcPath.osstring)	val colocate = mkPolicy (SrcPath.osstring, SrcPath.osstring, false)
68
69	fun separate { bindir, bootdir } = let	fun separate { bindir, bootdir } = let
70	fun shiftname root p =	fun shiftname root p =
#	Line 59	Line 74
74	" is not an anchored path!\n"];	" is not an anchored path!\n"];
75	raise Fail "bad path")	raise Fail "bad path")
76	in	in
77	mkPolicy (shiftname bindir, shiftname bootdir)	mkPolicy (shiftname bindir, shiftname bootdir, true)
78	end	end
79
80	fun mkBinName (p: policy) s = #bin p s	fun mkBinName (p: policy) s = #bin p s
81	fun mkSkelName (p: policy) s = #skel p s	fun mkSkelName (p: policy) s = #skel p s
82	fun mkStableName (p: policy) s = #stable p s	fun mkStableName (p: policy) (s, v) = #stable p (s, v)
83	end	end
84
85	structure FilenamePolicy =	structure FilenamePolicy =
86	FilenamePolicyFn (val cmdir = "CM" val skeldir = "SKEL")	FilenamePolicyFn (val cmdir = "CM" val skeldir = "SKEL"
87		val versiondir = Version.toString)

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.631   changed lines   Added in v.632

---

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