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/branches/primop-branch/src/cm/main/autoload.sml
ViewVC logotype

Diff of /sml/branches/primop-branch/src/cm/main/autoload.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1470, Mon Mar 29 22:45:55 2004 UTC revision 1471, Mon Mar 29 22:45:55 2004 UTC
# Line 17  Line 17 
17    
18      val register : ER.envref * GG.group -> unit      val register : ER.envref * GG.group -> unit
19    
20      val mkManager : { get_ginfo: unit -> GP.info, dropPickles: unit -> unit }      val mkManagers : { get_ginfo: unit -> GP.info, dropPickles: unit -> unit }
21          -> Ast.dec * ER.envref -> unit                       -> { manageImport: Ast.dec * ER.envref -> unit,
22                              managePrint : Symbol.symbol * ER.envref -> unit,
23                              getPending : unit -> Symbol.symbol list }
24    
25      val getPending : unit -> DG.impexp SymbolMap.map      val getPending : unit -> DG.impexp SymbolMap.map
26    
# Line 76  Line 78 
78              pending := SymbolMap.unionWith #1 (newNodes, !pending)              pending := SymbolMap.unionWith #1 (newNodes, !pending)
79          end          end
80    
81      fun mkManager { get_ginfo, dropPickles } (ast, ter: ER.envref) = let      fun mkManagers { get_ginfo, dropPickles } = let
82            (* manage a list of symbols for which modules need to be loaded *)
83            fun manage (genloadmap, ter: ER.envref, quiet) = let
84          val gp = get_ginfo ()          val gp = get_ginfo ()
85    
86          fun loadit m = let          fun loadit m = let
# Line 92  Line 95 
95              SymbolMap.foldl one (SOME E.emptyEnv) m              SymbolMap.foldl one (SOME E.emptyEnv) m
96          end          end
97    
         val { skeleton, ... } =  
             SkelCvt.convert { tree = ast, err = fn _ => fn _ => fn _ => () }  
98          val te = #get ter ()          val te = #get ter ()
99          val ste = E.staticPart te          val ste = E.staticPart te
100    
# Line 103  Line 104 
104              (SE.look (ste, sy); false) handle SE.Unbound => true              (SE.look (ste, sy); false) handle SE.Unbound => true
105          val pend = SymbolMap.filteri notTopDefined (!pending)          val pend = SymbolMap.filteri notTopDefined (!pending)
106          val _ = pending := pend          val _ = pending := pend
         val (dae, _) = Statenv2DAEnv.cvt ste  
         val load = ref SymbolMap.empty  
         val announce = let  
             val announced = ref false  
         in  
             fn () =>  
             (if !announced then ()  
              else (announced := true;  
                    Say.say ["[autoloading]\n"]))  
         end  
         fun lookpend sy = let  
             fun otherwise _ = EM.impossible "Autoload:lookpend"  
         in  
             case SymbolMap.find (pend, sy) of  
                 SOME (x as ((_, e, _), _)) =>  
                     (announce ();  
                      load := SymbolMap.insert (!load, sy, x);  
                      BuildDepend.look otherwise e sy)  
               | NONE => DAEnv.EMPTY  
         end  
         val lookimport = BuildDepend.look lookpend dae  
         val _ = BuildDepend.processOneSkeleton lookimport skeleton  
107    
108          (* Here are the nodes that actually have been picked because              val loadmap0 = genloadmap pend
          * something demanded an exported symbol: *)  
         val loadmap0 = !load  
109    
110          (* However, we want to avoid hanging on to stuff unnecessarily, so          (* However, we want to avoid hanging on to stuff unnecessarily, so
111           * we now look for symbols that become available "for free" because           * we now look for symbols that become available "for free" because
# Line 159  Line 136 
136                         SOME e =>                         SOME e =>
137                             (#set ter (E.concatEnv (e, te));                             (#set ter (E.concatEnv (e, te));
138                              pending := noloadmap;                              pending := noloadmap;
139                              Say.say ["[autoloading done]\n"])                                         if not quiet then
140                                               Say.say ["[autoloading done]\n"]
141                                           else ())
142                       | NONE => raise Fail "unable to load module(s)") }                       | NONE => raise Fail "unable to load module(s)") }
143                handle Fail msg =>                handle Fail msg =>
144                    Say.say ["[autoloading failed: ", msg, "]\n"];                    Say.say ["[autoloading failed: ", msg, "]\n"];
145                dropPickles ())                dropPickles ())
146      end      end
147    
148            fun mkAnnounce () =  let
149                val announced = ref false
150            in
151                fn () =>
152                   (if !announced then ()
153                    else (announced := true;
154                          Say.say ["[autoloading]\n"]))
155            end
156    
157            fun manageImports (ast, ter: ER.envref) = let
158                val { skeleton, ... } =
159                    SkelCvt.convert { tree = ast,
160                                      err = fn _ => fn _ => fn _ => () }
161                fun genloadmap pend = let
162                    val te = #get ter ()
163                    val ste = E.staticPart te
164                    val (dae, _) = Statenv2DAEnv.cvt ste
165                    val load = ref SymbolMap.empty
166                    val announce = mkAnnounce ()
167                    fun lookpend sy = let
168                        fun otherwise _ = EM.impossible "Autoload:lookpend"
169                    in
170                        case SymbolMap.find (pend, sy) of
171                            SOME (x as ((_, e, _), _)) =>
172                            (announce ();
173                             load := SymbolMap.insert (!load, sy, x);
174                             BuildDepend.look otherwise e sy)
175                          | NONE => DAEnv.EMPTY
176                    end
177                    val lookimport = BuildDepend.look lookpend dae
178                    val _ = BuildDepend.processOneSkeleton lookimport skeleton
179                in
180                    !load
181                end
182            in
183                manage (genloadmap, ter, false)
184            end
185    
186            fun managePrint (sy, ter) = let
187                fun genloadmap pend = let
188                    (* val announce = mkAnnounce () *)
189                    fun announce () = ()    (* should not announce in the
190                                             * middle of pretty-printing... *)
191                in
192                    case SymbolMap.find (pend, sy) of
193                        SOME x => (announce ();
194                                   SymbolMap.singleton (sy, x))
195                      | NONE => SymbolMap.empty
196                end
197            in
198                manage (genloadmap, ter, true)
199            end
200        in
201            { manageImport = manageImports,
202              managePrint = managePrint,
203              getPending = fn () => SymbolMap.listKeys (!pending) }
204        end
205    
206      fun getPending () = SymbolMap.map #1 (!pending)      fun getPending () = SymbolMap.map #1 (!pending)
207  end  end
208  end  end

Legend:
Removed from v.1470  
changed lines
  Added in v.1471

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