Diff of /sml/trunk/src/cm/depend/build.sml

Parent Directory | Revision Log | Patch

	revision 282, Wed May 19 05:14:03 1999 UTC	revision 283, Wed May 19 08:20:58 1999 UTC
#	Line 1	Line 1
1	signature BUILDDEPEND = sig	signature BUILDDEPEND = sig
2	val build : { subexports: (DependencyGraph.farsbnode * DependencyGraph.env)	type impexp = DependencyGraph.impexp
3	SymbolMap.map,
4		val build :
5		{ imports: impexp SymbolMap.map,
6		gimports: impexp SymbolMap.map,
7	smlfiles: SmlInfo.info list,	smlfiles: SmlInfo.info list,
8	localdefs: SmlInfo.info SymbolMap.map }	localdefs: SmlInfo.info SymbolMap.map }
9	-> { nodemap: DependencyGraph.snode SymbolMap.map,	* SymbolSet.set option          (* filter *)
10	rootset: DependencyGraph.snode list }	* (string -> unit)              (* error *)
11		->
12		impexp SymbolMap.map            (* exports *)
13	end	end
14
15	structure BuildDepend :> BUILDDEPEND = struct	structure BuildDepend :> BUILDDEPEND = struct
#	Line 17	Line 22
22	structure EM = GenericVC.ErrorMsg	structure EM = GenericVC.ErrorMsg
23	structure SP = GenericVC.SymPath	structure SP = GenericVC.SymPath
24
25		type impexp = DG.impexp
26
27	fun look otherwise DG.EMPTY s = otherwise s	fun look otherwise DG.EMPTY s = otherwise s
28	| look otherwise (DG.BINDING (s', v)) s =	| look otherwise (DG.BINDING (s', v)) s =
29	if S.eq (s, s') then v else otherwise s	if S.eq (s, s') then v else otherwise s
#	Line 29	Line 36
36	S.nameSpaceToString (S.nameSpace s) :: " " ::	S.nameSpaceToString (S.nameSpace s) :: " " ::
37	S.name s :: r	S.name s :: r
38
39	fun build { subexports, smlfiles, localdefs } = let	fun build (coll, fopt, error) = let
40		val { imports, gimports, smlfiles, localdefs } = coll
41
42	(* the "blackboard" where analysis results are announced *)	(* the "blackboard" where analysis results are announced *)
43	(* (also used for cycle detection) *)	(* (also used for cycle detection) *)
#	Line 127	Line 135
135	* global imports. *)	* global imports. *)
136	fun lookimport s = let	fun lookimport s = let
137	fun lookfar () =	fun lookfar () =
138	case SM.find (subexports, s) of	case SM.find (imports, s) of
139	SOME (farn, e) => (globalImport farn; e)	SOME (farn, e) => (globalImport farn; e)
140	| NONE => (SmlInfo.error i	| NONE => (SmlInfo.error i
141	(concat (AbsPath.spec f ::	(concat (AbsPath.spec f ::
#	Line 247	Line 255
255	* and the root set to be updated accordingly *)	* and the root set to be updated accordingly *)
256	fun doSmlFile i = ignore (getResult (i, []))	fun doSmlFile i = ignore (getResult (i, []))
257
258	(* converting smlinfos to nodes *)	(* converting smlinfos to sbnodes * env *)
259	val i2n = #1 o valOf o valOf o fetch	fun i2sbn i = let
260		val (sn, e) = valOf (valOf (fetch i))
261	in	in
262		(DG.SB_SNODE sn, e)
263		end
264
265	(* run the analysis *)	(* run the analysis *)
266	app doSmlFile smlfiles;	val _ = app doSmlFile smlfiles
267	(* generate map from export symbol to node and
268	* also return the root set *)	fun addDummyFilt (sbn, e) = ((NONE, sbn), e)
269	{ nodemap = SM.map i2n localdefs,
270	rootset = map i2n (AbsPathMap.listItems (!rs)) }	(* First we make a map of all locally defined symbols to
271		* the local "far sb node"
272		* but with only a dummy filter attached.
273		* This makes it consistent with the current state
274		* of "imports" and "gimports" where there can be filters, but
275		* where those filters are not yet strengthened according to fopt *)
276		val localmap = SM.map (addDummyFilt o i2sbn) localdefs
277
278		val exports =
279		case fopt of
280		NONE =>
281		(* There is no filter -- so we are in an ordinary
282		* group and should export all gimports as well as
283		* all local definitions.
284		* No filter strengthening is necessary. *)
285		SM.unionWith #1 (localmap, gimports)
286		| SOME ss => let
287		(* There is a filter.
288		* We export only the things in the filter.
289		* They can be taken from either localmap or else from
290		* imports.  In either case, it is necessary to strengthen
291		* the filter attached to each node. *)
292		fun strengthen ((fopt', sbn), e) = let
293		exception Unbound
294		fun addB (s, e') = let
295		val v = look (fn _ => raise Unbound) e s
296		in
297		DG.LAYER (DG.BINDING (s, v), e')
298		end handle Unbound => e'
299		val new_e = SS.foldl addB DG.EMPTY ss
300		val new_fopt =
301		case fopt' of
302		NONE => fopt
303		| SOME ss' => SOME (SS.intersection (ss, ss'))
304		in
305		((new_fopt, sbn), new_e)
306		end
307		val availablemap = SM.unionWith #1 (localmap, imports)
308		fun addNodeFor (s, m) =
309		case SM.find (availablemap, s) of
310		SOME n => SM.insert (m, s, strengthen n)
311		| NONE => (error
312		(concat ("exported " ::
313		symDesc (s, [" not defined"])));
314		m)
315		in
316		SS.foldl addNodeFor SM.empty ss
317		end
318
319		(* Find dangling (unreachable) nodes.
320		* For this, we first build an AbsPathSet.set of all the SNODEs in the
321		* exporct map.  Then we build another such set that is the domain of
322		* the root set.  By subtracting the former from the latter we get
323		* the set of dangling nodes. *)
324		fun addR (p, _, s) = AbsPathSet.add (s, p)
325		val rootPathSet = AbsPathMap.foldli addR AbsPathSet.empty (!rs)
326
327		fun addE (((_, DG.SB_SNODE (DG.SNODE { smlinfo =i, ... })), _), s) =
328		AbsPathSet.add (s, SmlInfo.sourcepath i)
329		| addE (_, s) = s
330		val exportPathSet = SM.foldl addE AbsPathSet.empty exports
331
332		val danglingPaths = AbsPathSet.difference (rootPathSet, exportPathSet)
333
334		fun complainDangle p = let
335		val i = valOf (AbsPathMap.find (!rs, p))
336		in
337		SmlInfo.error i
338		(concat ["compilation unit ", AbsPath.spec p, " unreachable"])
339		EM.nullErrorBody
340		end
341		in
342		AbsPathSet.app complainDangle danglingPaths;
343		exports
344	end	end
345	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.282   changed lines   Added in v.283

---

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