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 291, Mon May 24 09:41:07 1999 UTC revision 299, Thu May 27 13:53:27 1999 UTC
# Line 12  Line 12 
12          { imports: impexp SymbolMap.map,          { imports: impexp SymbolMap.map,
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 }
17          * SymbolSet.set option          (* filter *)          * SymbolSet.set option          (* filter *)
18          * (string -> unit)              (* error *)          * (string -> unit)              (* error *)
19            * GeneralParams.info
20          ->          ->
21          impexp SymbolMap.map            (* exports *)          impexp SymbolMap.map            (* exports *)
22  end  end
# Line 43  Line 45 
45    
46      (* get the description for a symbol *)      (* get the description for a symbol *)
47      fun symDesc (s, r) =      fun symDesc (s, r) =
48          S.nameSpaceToString (S.nameSpace s) :: " " ::          S.nameSpaceToString (S.nameSpace s) :: " " :: S.name s :: r
         S.name s :: r  
49    
50      fun build (coll, fopt, error) = let      fun build (coll, fopt, error, gp) = let
51          val { imports, gimports, smlfiles, localdefs } = coll          val { imports, gimports, smlfiles, localdefs, subgroups } = coll
52    
53          (* the "blackboard" where analysis results are announced *)          (* the "blackboard" where analysis results are announced *)
54          (* (also used for cycle detection) *)          (* (also used for cycle detection) *)
# Line 87  Line 88 
88                          recur (AbsPath.spec f, history)                          recur (AbsPath.spec f, history)
89                      end                      end
90                  in                  in
91                      SmlInfo.error i "cyclic ML dependencies" pphist;                      SmlInfo.error gp i EM.COMPLAIN
92                             "cyclic ML dependencies" pphist;
93                      release (i, (DG.SNODE { smlinfo = i,                      release (i, (DG.SNODE { smlinfo = i,
94                                              localimports = [],                                              localimports = [],
95                                              globalimports = [] },                                              globalimports = [] },
# Line 139  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 i                        | NONE => (SmlInfo.error gp i EM.COMPLAIN
145                                    (concat (AbsPath.spec f ::                                    (concat (AbsPath.spec f ::
146                                             ": reference to unknown " ::                                             ": reference to unknown " ::
147                                             symDesc (s, [])))                                             symDesc (s, [])))
# Line 167  Line 169 
169                        | dotPath [s] = [S.name s]                        | dotPath [s] = [S.name s]
170                        | dotPath (h :: t) = S.name h :: "." :: dotPath t                        | dotPath (h :: t) = S.name h :: "." :: dotPath t
171                      fun complain s =                      fun complain s =
172                          (SmlInfo.error i                          (SmlInfo.error gp i EM.COMPLAIN
173                            (concat                            (concat
174                             (AbsPath.spec f ::                             (AbsPath.spec f ::
175                              ": undefined " ::                              ": undefined " ::
# Line 185  Line 187 
187    
188              (* "eval" -- compute the export environment of a skeleton *)              (* "eval" -- compute the export environment of a skeleton *)
189              fun eval sk = let              fun eval sk = let
                 fun layer' f [] = DE.EMPTY  
                   | layer' f [x] = f x  
                   | layer' f (h :: t) =  
                     foldl (fn (x, r) => DE.LAYER (f x, r)) (f h) t  
   
190                  fun evalDecl e (SK.Bind (name, def)) =                  fun evalDecl e (SK.Bind (name, def)) =
191                      DE.BINDING (name, evalModExp e def)                      DE.BINDING (name, evalModExp e def)
192                    | evalDecl e (SK.Local (d1, d2)) =                    | evalDecl e (SK.Local (d1, d2)) =
193                      evalDecl (DE.LAYER (evalDecl e d1, e)) d2                      evalDecl (DE.LAYER (evalDecl e d1, e)) d2
194                    | evalDecl e (SK.Seq l) =                    | evalDecl e (SK.Seq l) = evalSeqDecl e l
195                      foldl (fn (d, e') =>                    | evalDecl e (SK.Par []) = DE.EMPTY
196                             DE.LAYER (evalDecl (DE.LAYER (e', e)) d, e'))                    | evalDecl e (SK.Par (h :: t)) =
197                            DE.EMPTY l                      foldl (fn (x, r) => DE.LAYER (evalDecl e x, r))
198                    | evalDecl e (SK.Par l) = layer' (evalDecl e) l                            (evalDecl e h) t
199                    | evalDecl e (SK.Open s) = evalModExp e s                    | evalDecl e (SK.Open s) = evalModExp e s
200                    | evalDecl e (SK.Ref s) =                    | evalDecl e (SK.Ref s) =
201                      (SS.app (ignore o lookup e) s; DE.EMPTY)                      (SS.app (ignore o lookup e) s; DE.EMPTY)
202    
203                    and evalSeqDecl e [] = DE.EMPTY
204                      | evalSeqDecl e (h :: t) = let
205                            fun one (d, e') =
206                                DE.LAYER (evalDecl (DE.LAYER (e', e)) d, e')
207                        in
208                            foldl one (evalDecl e h) t
209                        end
210    
211                  and evalModExp e (SK.Var sp) = lookSymPath e sp                  and evalModExp e (SK.Var sp) = lookSymPath e sp
212                    | evalModExp e (SK.Decl d) = evalDecl e d                    | evalModExp e (SK.Decl l) = evalSeqDecl e l
213                    | evalModExp e (SK.Let (d, m)) =                    | evalModExp e (SK.Let (d, m)) =
214                      evalModExp (DE.LAYER (evalDecl e d, e)) m                      evalModExp (DE.LAYER (evalSeqDecl e d, e)) m
215                    | evalModExp e (SK.Ign1 (m1, m2)) =                    | evalModExp e (SK.Ign1 (m1, m2)) =
216                      (ignore (evalModExp e m1); evalModExp e m2)                      (ignore (evalModExp e m1); evalModExp e m2)
217              in              in
218                  evalDecl DE.EMPTY sk                  evalDecl DE.EMPTY sk
219              end              end
220    
221              val e = eval (SmlInfo.skeleton i)              val e = eval (SmlInfo.skeleton gp i)
222              val n = DG.SNODE { smlinfo = i,              val n = DG.SNODE { smlinfo = i,
223                                 localimports = !li,                                 localimports = !li,
224                                 globalimports = !gi }                                 globalimports = !gi }

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

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