Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/depend/build.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch 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

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