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 300, Thu May 27 22:01:36 1999 UTC revision 301, Fri May 28 09:43:39 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) *)
# Line 132  Line 135 
135              val f = SmlInfo.sourcepath i              val f = SmlInfo.sourcepath i
136              fun isSelf i' = SmlInfo.eq (i, i')              fun isSelf i' = SmlInfo.eq (i, i')
137    
             exception Lookup  
   
138              (* lookup function for things not defined in the same ML file.              (* lookup function for things not defined in the same ML file.
139               * As a side effect, this function registers local and               * As a side effect, this function registers local and
140               * global imports. *)               * global imports. *)
# Line 141  Line 142 
142                  fun lookfar () =                  fun lookfar () =
143                      case SM.find (imports, s) of                      case SM.find (imports, s) of
144                          SOME (farn, e) => (globalImport farn; e)                          SOME (farn, e) => (globalImport farn; e)
145                        | NONE => (SmlInfo.error gp i EM.COMPLAIN                        | NONE =>
146                                    (concat (AbsPath.spec f ::                              (* We could complain here about an undefined
147                                             ": reference to unknown " ::                               * name.  However, since CM doesn't have the
148                                             symDesc (s, [])))                               * proper source locations available, it is
149                                    EM.nullErrorBody;                               * better to handle this case silently and
150                                   raise Lookup)                               * have the compiler catch the problem later. *)
151                                DE.EMPTY
152              in              in
153                  case SM.find (localdefs, s) of                  case SM.find (localdefs, s) of
154                      SOME i' =>                      SOME i' =>
# Line 161  Line 163 
163              end              end
164    
165              (* build the lookup function for DG.env *)              (* build the lookup function for DG.env *)
166              val lookup_exn = look lookimport              val lookup = look lookimport
167    
168              fun lookSymPath e (SP.SPATH []) = DE.EMPTY              fun lookSymPath e (SP.SPATH []) = DE.EMPTY
169                | lookSymPath e (SP.SPATH (p as (h :: t))) = let                | lookSymPath e (SP.SPATH (p as (h :: t))) = let
170                      fun dotPath [] = []                      (* again, if we don't find it here we just ignore
171                        | dotPath [s] = [S.name s]                       * the problem and let the compiler catch it later *)
172                        | 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  
173                      fun loop (e, []) = e                      fun loop (e, []) = e
174                        | loop (e, h :: t) = loop (lookup_exn' e h, t)                        | loop (e, h :: t) = loop (lookup' e h, t)
175                  in                  in
176                      loop (lookup_exn e h, t) handle Lookup => DE.EMPTY                      loop (lookup e h, t)
177                  end                  end
178    
             fun lookup e s = lookup_exn e s handle Lookup => DE.EMPTY  
   
179              (* "eval" -- compute the export environment of a skeleton *)              (* "eval" -- compute the export environment of a skeleton *)
180              fun eval sk = let              fun eval sk = let
181                  fun evalDecl e (SK.Bind (name, def)) =                  fun evalDecl e (SK.Bind (name, def)) =
# Line 218  Line 209 
209                  evalDecl DE.EMPTY sk                  evalDecl DE.EMPTY sk
210              end              end
211    
212              val e = eval (SmlInfo.skeleton gp i)              val e = case SmlInfo.skeleton gp i of
213                    SOME sk => eval sk
214                  | NONE => DE.EMPTY
215    
216              val n = DG.SNODE { smlinfo = i,              val n = DG.SNODE { smlinfo = i,
217                                 localimports = !li,                                 localimports = !li,
218                                 globalimports = !gi }                                 globalimports = !gi }
# Line 284  Line 278 
278                      SS.foldl addNodeFor SM.empty ss                      SS.foldl addNodeFor SM.empty ss
279                  end                  end
280      in      in
281          exports          (exports, reqpriv)
282      end      end
283  end  end

Legend:
Removed from v.300  
changed lines
  Added in v.301

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