Diff of /sml/trunk/src/system/smlnj/installer/libinstall.sml

Parent Directory | Revision Log | Patch

	revision 1484, Sat Apr 24 13:30:51 2004 UTC	revision 1485, Tue May 11 16:36:07 2004 UTC
#	Line 30	Line 30
30	structure SI = SMLofNJ.SysInfo	structure SI = SMLofNJ.SysInfo
31	structure SM = RedBlackMapFn (type ord_key = string	structure SM = RedBlackMapFn (type ord_key = string
32	val compare = String.compare)	val compare = String.compare)
33		structure SS = RedBlackSetFn (type ord_key = string
34		val compare = String.compare)
35
36	structure SCC = GraphSCCFn (type ord_key = string	structure SCC = GraphSCCFn (type ord_key = string
37	val compare = String.compare)	val compare = String.compare)
#	Line 136	Line 138
138	[P.concat (configdir, "targets.customized"),	[P.concat (configdir, "targets.customized"),
139	P.concat (configdir, "targets")]	P.concat (configdir, "targets")]
140
141		val allsrcfile = P.concat (configdir, "allsources")
142
143	val s =	val s =
144	case List.find fexists targetsfiles of	case List.find fexists targetsfiles of
145	SOME f => TextIO.openIn f	SOME f => TextIO.openIn f
146	| NONE => fail ["no targetsfiles\n"]	| NONE => fail ["no targetsfiles\n"]
147
148	(* parse the targets file *)	(* parse the targets file *)
149	fun loop ml =	fun loop (ml, allsrc) =
150	case TextIO.inputLine s of	case TextIO.inputLine s of
151	NONE => (TextIO.closeIn s; ml)	NONE => (TextIO.closeIn s; (ml, allsrc))
152	| SOME l =>	| SOME l =>
153	if String.sub (l, 0) = #"#" then loop ml	if String.sub (l, 0) = #"#" then loop (ml, allsrc)
154	else (case String.tokens Char.isSpace l of	else (case String.tokens Char.isSpace l of
155	[x as ("dont_move_libraries" |	[x as ("dont_move_libraries" |
156	"move_libraries")] =>	"move_libraries")] =>
157	(warn ["\"", x, "\" no longer supported",	(warn ["\"", x, "\" no longer supported",
158	" (installer always moves libraries)\n"];	" (installer always moves libraries)\n"];
159	loop ml)	loop (ml, allsrc))
160	| ["request", module] => loop (module :: ml)	| ["request", "src-smlnj"] => loop (ml, true)
161	| [] => loop ml	| ["request", module] => loop (module :: ml, allsrc)
162		| [] => loop (ml, allsrc)
163	| _ => fail ["ill-formed targets line: ", l])	| _ => fail ["ill-formed targets line: ", l])
164
165	val modules = loop []	val (modules, allsrc) = loop ([], false)
166
167	(* now resolve dependencies; get full list of modules	(* now resolve dependencies; get full list of modules
168	* in correct build order: *)	* in correct build order: *)
169	val modules = resolve (modules, depfile)	val modules = resolve (modules, depfile)
170
171		val moduleset = SS.addList (SS.empty, modules)
172
173		val srcmoduleset =
174		if allsrc andalso fexists allsrcfile then
175		let val s = TextIO.openIn allsrcfile
176		fun one (m, ms) =
177		if SS.member (ms, m) then ms else SS.add (ms, m)
178		fun loop ms =
179		case TextIO.inputLine s of
180		NONE => (TextIO.closeIn s; ms)
181		| SOME l =>
182		if String.sub (l, 0) = #"#" then loop ms
183		else loop (foldl one ms
184		(String.tokens Char.isSpace l))
185		in
186		loop moduleset
187		end
188		else moduleset
189
190	(* fetch and unpack source trees, using auxiliary helper command	(* fetch and unpack source trees, using auxiliary helper command
191	* which takes the root directory as its first and the module	* which takes the root directory as its first and the module
192	* names to be fetched as subsequent arguments. *)	* names to be fetched as subsequent arguments. *)
#	Line 171	Line 195
195	| SOME cmd => let	| SOME cmd => let
196	val cmdline =	val cmdline =
197	concat (cmd :: " " :: smlnjroot :: " " ::	concat (cmd :: " " :: smlnjroot :: " " ::
198	foldr (fn (f, l) => " " :: f :: l)	SS.foldl (fn (f, l) => " " :: f :: l)
199	[] modules)	[] srcmoduleset)
200	in	in
201	if OS.Process.system cmdline = OS.Process.success	if OS.Process.system cmdline = OS.Process.success
202	then ()	then ()

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.1484   changed lines   Added in v.1485

---

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