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 299, Thu May 27 13:53:27 1999 UTC revision 305, Mon May 31 15:00:06 1999 UTC
# Line 13  Line 13 
13            gimports: impexp SymbolMap.map,            gimports: impexp SymbolMap.map,
14            smlfiles: SmlInfo.info list,            smlfiles: SmlInfo.info list,
15            localdefs: SmlInfo.info SymbolMap.map,            localdefs: SmlInfo.info SymbolMap.map,
16            subgroups: GroupGraph.group list }            subgroups: GroupGraph.group list,
17              reqpriv: GroupGraph.privileges }
18          * SymbolSet.set option          (* filter *)          * SymbolSet.set option          (* filter *)
19          * (string -> unit)              (* error *)          * (string -> unit)              (* error *)
20          * GeneralParams.info          * GeneralParams.info
21          ->          ->
22          impexp SymbolMap.map            (* exports *)          impexp SymbolMap.map            (* exports *)
23            * GroupGraph.privileges         (* required privileges (aggregate) *)
24  end  end
25    
26  structure BuildDepend :> BUILDDEPEND = struct  structure BuildDepend :> BUILDDEPEND = struct
# Line 48  Line 50 
50          S.nameSpaceToString (S.nameSpace s) :: " " :: S.name s :: r          S.nameSpaceToString (S.nameSpace s) :: " " :: S.name s :: r
51    
52      fun build (coll, fopt, error, gp) = let      fun build (coll, fopt, error, gp) = let
53          val { imports, gimports, smlfiles, localdefs, subgroups } = coll          val { imports, gimports, smlfiles, localdefs, subgroups, reqpriv } =
54                coll
55    
56          (* the "blackboard" where analysis results are announced *)          (* the "blackboard" where analysis results are announced *)
57          (* (also used for cycle detection) *)          (* (also used for cycle detection) *)
58          val bb = ref AbsPathMap.empty          val bb = ref SmlInfoMap.empty
59          fun lock i = bb := AbsPathMap.insert (!bb, SmlInfo.sourcepath i, NONE)          fun lock i = bb := SmlInfoMap.insert (!bb, i, NONE)
60          fun release (i, r) =          fun release (i, r) = (bb := SmlInfoMap.insert (!bb, i, SOME r); r)
61              (bb := AbsPathMap.insert (!bb, SmlInfo.sourcepath i, SOME r); r)          fun fetch i = SmlInfoMap.find (!bb, i)
         fun fetch i = AbsPathMap.find (!bb, SmlInfo.sourcepath i)  
62    
63          (* - get the result from the blackboard if it is there *)          (* - get the result from the blackboard if it is there *)
64          (* - otherwise trigger analysis *)          (* - otherwise trigger analysis *)
# Line 132  Line 134 
134              val f = SmlInfo.sourcepath i              val f = SmlInfo.sourcepath i
135              fun isSelf i' = SmlInfo.eq (i, i')              fun isSelf i' = SmlInfo.eq (i, i')
136    
             exception Lookup  
   
137              (* lookup function for things not defined in the same ML file.              (* lookup function for things not defined in the same ML file.
138               * As a side effect, this function registers local and               * As a side effect, this function registers local and
139               * global imports. *)               * global imports. *)
# Line 141  Line 141 
141                  fun lookfar () =                  fun lookfar () =
142                      case SM.find (imports, s) of                      case SM.find (imports, s) of
143                          SOME (farn, e) => (globalImport farn; e)                          SOME (farn, e) => (globalImport farn; e)
144                        | NONE => (SmlInfo.error gp i EM.COMPLAIN                        | NONE =>
145                                    (concat (AbsPath.spec f ::                              (* We could complain here about an undefined
146                                             ": reference to unknown " ::                               * name.  However, since CM doesn't have the
147                                             symDesc (s, [])))                               * proper source locations available, it is
148                                    EM.nullErrorBody;                               * better to handle this case silently and
149                                   raise Lookup)                               * have the compiler catch the problem later. *)
150                                DE.EMPTY
151              in              in
152                  case SM.find (localdefs, s) of                  case SM.find (localdefs, s) of
153                      SOME i' =>                      SOME i' =>
# Line 161  Line 162 
162              end              end
163    
164              (* build the lookup function for DG.env *)              (* build the lookup function for DG.env *)
165              val lookup_exn = look lookimport              val lookup = look lookimport
166    
167              fun lookSymPath e (SP.SPATH []) = DE.EMPTY              fun lookSymPath e (SP.SPATH []) = DE.EMPTY
168                | lookSymPath e (SP.SPATH (p as (h :: t))) = let                | lookSymPath e (SP.SPATH (p as (h :: t))) = let
169                      fun dotPath [] = []                      (* again, if we don't find it here we just ignore
170                        | dotPath [s] = [S.name s]                       * the problem and let the compiler catch it later *)
171                        | dotPath (h :: t) = S.name h :: "." :: dotPath t                      val lookup' = look (fn _ => DE.EMPTY)
                     fun complain s =  
                         (SmlInfo.error gp i EM.COMPLAIN  
                           (concat  
                            (AbsPath.spec f ::  
                             ": undefined " ::  
                             symDesc (s, " in path " :: dotPath p)))  
                           EM.nullErrorBody;  
                          raise Lookup)  
                     val lookup_exn' = look complain  
172                      fun loop (e, []) = e                      fun loop (e, []) = e
173                        | loop (e, h :: t) = loop (lookup_exn' e h, t)                        | loop (e, h :: t) = loop (lookup' e h, t)
174                  in                  in
175                      loop (lookup_exn e h, t) handle Lookup => DE.EMPTY                      loop (lookup e h, t)
176                  end                  end
177    
             fun lookup e s = lookup_exn e s handle Lookup => DE.EMPTY  
   
178              (* "eval" -- compute the export environment of a skeleton *)              (* "eval" -- compute the export environment of a skeleton *)
179              fun eval sk = let              fun eval sk = let
180                  fun evalDecl e (SK.Bind (name, def)) =                  fun evalDecl e (SK.Bind (name, def)) =
# Line 218  Line 208 
208                  evalDecl DE.EMPTY sk                  evalDecl DE.EMPTY sk
209              end              end
210    
211              val e = eval (SmlInfo.skeleton gp i)              val e = case SmlInfo.skeleton gp i of
212                    SOME sk => eval sk
213                  | NONE => DE.EMPTY
214    
215              val n = DG.SNODE { smlinfo = i,              val n = DG.SNODE { smlinfo = i,
216                                 localimports = !li,                                 localimports = !li,
217                                 globalimports = !gi }                                 globalimports = !gi }
# Line 284  Line 277 
277                      SS.foldl addNodeFor SM.empty ss                      SS.foldl addNodeFor SM.empty ss
278                  end                  end
279      in      in
280          exports          (exports, reqpriv)
281      end      end
282  end  end

Legend:
Removed from v.299  
changed lines
  Added in v.305

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