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

Parent Directory | Revision Log

---

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

---

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