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 353, Thu Jun 24 09:43:28 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: (AbsPath.t * 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 38  Line 40 
40        | look otherwise (DE.BINDING (s', v)) s =        | look otherwise (DE.BINDING (s', v)) s =
41          if S.eq (s, s') then v else otherwise s          if S.eq (s, s') then v else otherwise s
42        | look otherwise (DE.LAYER (e, e')) s = look (look otherwise e') e s        | look otherwise (DE.LAYER (e, e')) s = look (look otherwise e') e s
43        | look otherwise (DE.FCTENV { looker, domain }) s =        | look otherwise (DE.FCTENV looker) s =
44          (case looker s of NONE => otherwise s | SOME v => v)          (case looker s of NONE => otherwise s | SOME v => v)
45        | look otherwise (DE.FILTER (ss, e)) s =        | look otherwise (DE.FILTER (ss, e)) s =
46          if SymbolSet.member (ss, s) then look otherwise e s else otherwise s          if SymbolSet.member (ss, s) then look otherwise e s else otherwise s
# 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 72  Line 74 
74                          fun recur (_, []) = () (* shouldn't happen *)                          fun recur (_, []) = () (* shouldn't happen *)
75                            | recur (n'', (s, i') :: r) = let                            | recur (n'', (s, i') :: r) = let
76                                  val f' = SmlInfo.sourcepath i'                                  val f' = SmlInfo.sourcepath i'
77                                  val n' = AbsPath.spec f'                                  val n' = AbsPath.specOf f'
78                                  val _ =                                  val _ =
79                                      if SmlInfo.eq (i, i') then ()                                      if SmlInfo.eq (i, i') then ()
80                                      else recur (n', r)                                      else recur (n', r)
# Line 85  Line 87 
87                              end                              end
88                      in                      in
89                          PrettyPrint.add_newline pps;                          PrettyPrint.add_newline pps;
90                          recur (AbsPath.spec f, history)                          recur (AbsPath.specOf f, history)
91                      end                      end
92                  in                  in
93                      SmlInfo.error gp i EM.COMPLAIN                      SmlInfo.error gp i EM.COMPLAIN
# 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. *)
140              fun lookimport s = let              fun lookimport s = let
141                    fun internalError s =
142                        EM.impossible "build/lookimport/lookfar"
143                  fun lookfar () =                  fun lookfar () =
144                      case SM.find (imports, s) of                      case SM.find (imports, s) of
145                          SOME (farn, e) => (globalImport farn; e)                          SOME (farn, e) => (globalImport farn;
146                        | NONE => (SmlInfo.error gp i EM.COMPLAIN                                             look internalError e s)
147                                    (concat (AbsPath.spec f ::                        | NONE =>
148                                             ": reference to unknown " ::                              (* We could complain here about an undefined
149                                             symDesc (s, [])))                               * name.  However, since CM doesn't have the
150                                    EM.nullErrorBody;                               * proper source locations available, it is
151                                   raise Lookup)                               * better to handle this case silently and
152                                 * have the compiler catch the problem later. *)
153                                DE.EMPTY
154              in              in
155                  case SM.find (localdefs, s) of                  case SM.find (localdefs, s) of
156                      SOME i' =>                      SOME i' =>
# Line 161  Line 165 
165              end              end
166    
167              (* build the lookup function for DG.env *)              (* build the lookup function for DG.env *)
168              val lookup_exn = look lookimport              val lookup = look lookimport
169    
170              fun lookSymPath e (SP.SPATH []) = DE.EMPTY              fun lookSymPath e (SP.SPATH []) = DE.EMPTY
171                | lookSymPath e (SP.SPATH (p as (h :: t))) = let                | lookSymPath e (SP.SPATH (p as (h :: t))) = let
172                      fun dotPath [] = []                      (* again, if we don't find it here we just ignore
173                        | dotPath [s] = [S.name s]                       * the problem and let the compiler catch it later *)
174                        | 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  
175                      fun loop (e, []) = e                      fun loop (e, []) = e
176                        | loop (e, h :: t) = loop (lookup_exn' e h, t)                        | loop (e, h :: t) = loop (lookup' e h, t)
177                  in                  in
178                      loop (lookup_exn e h, t) handle Lookup => DE.EMPTY                      loop (lookup e h, t)
179                  end                  end
180    
             fun lookup e s = lookup_exn e s handle Lookup => DE.EMPTY  
   
181              (* "eval" -- compute the export environment of a skeleton *)              (* "eval" -- compute the export environment of a skeleton *)
182              fun eval sk = let              fun eval sk = let
183                  fun evalDecl e (SK.Bind (name, def)) =                  fun evalDecl e (SK.Bind (name, def)) =
# Line 218  Line 211 
211                  evalDecl DE.EMPTY sk                  evalDecl DE.EMPTY sk
212              end              end
213    
214              val e = eval (SmlInfo.skeleton gp i)              val e = case SmlInfo.skeleton gp i of
215                    SOME sk => eval sk
216                  | NONE => DE.EMPTY
217    
218              val n = DG.SNODE { smlinfo = i,              val n = DG.SNODE { smlinfo = i,
219                                 localimports = !li,                                 localimports = !li,
220                                 globalimports = !gi }                                 globalimports = !gi }
# Line 284  Line 280 
280                      SS.foldl addNodeFor SM.empty ss                      SS.foldl addNodeFor SM.empty ss
281                  end                  end
282      in      in
283          exports          (exports, reqpriv)
284      end      end
285  end  end

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

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