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/compile/compile.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/compile/compile.sml

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

revision 771, Sat Dec 30 13:06:09 2000 UTC revision 801, Mon Mar 19 22:53:00 2001 UTC
# Line 47  Line 47 
47    
48          val newTraversal : notifier * bfcReceiver * GG.group ->          val newTraversal : notifier * bfcReceiver * GG.group ->
49              { group: GP.info -> result option,              { group: GP.info -> result option,
50                  allgroups: GP.info -> bool,
51                exports: (GP.info -> result option) SymbolMap.map }                exports: (GP.info -> result option) SymbolMap.map }
52      end      end
53    
# Line 237  Line 238 
238                                                  (#inlinfo, "inlinable")]))                                                  (#inlinfo, "inlinable")]))
239                  end                  end
240    
241                  fun ploaded _ = Say.vsay ["[loading ", descr, "]\n"]                  fun loaded _ = Say.vsay ["[loading ", descr, "]\n"]
242                  fun preceived s =                  fun received s =
243                      (Say.vsay ["[receiving ", descr, "]\n"]; pstats s)                      (Say.vsay ["[receiving ", descr, "]\n"];
244                         pstats s)
245    
246                  fun fail () =                  fun fail () =
247                      if #keep_going (#param gp) then NONE else raise Abort                      if #keep_going (#param gp) then NONE else raise Abort
# Line 372  Line 374 
374                                              cleanup = fn _ => () })                                              cleanup = fn _ => () })
375                                      handle _ => NONE                                      handle _ => NONE
376                                  end (* load *)                                  end (* load *)
377                                  fun tryload (report, otherwise) =                                  fun tryload (sync, report, otherwise) =
378                                      case load () of                                      case (sync (); load ()) of
379                                          NONE => otherwise ()                                          NONE => otherwise ()
380                                        | SOME (bfc, ts, stats) => let                                        | SOME (bfc, ts, stats) => let
381                                              val memo = bfc2memo (bfc, ts)                                              val memo = bfc2memo (bfc, ts)
# Line 386  Line 388 
388                                                   SOME memo)                                                   SOME memo)
389                                              else otherwise ()                                              else otherwise ()
390                                          end                                          end
391                                    fun sy0 () = ()
392                                  fun bottleneck () =                                  fun bottleneck () =
393                                      (* Are we the only runable task? *)                                      (* Are we the only runable task? *)
394                                      Servers.allIdle () andalso                                      Servers.allIdle () andalso
# Line 398  Line 401 
401                                      compile_there p                                      compile_there p
402                                  fun compile () = let                                  fun compile () = let
403                                      val sp = SmlInfo.sourcepath i                                      val sp = SmlInfo.sourcepath i
404                                        fun sy () = let
405                                            fun ready () =
406                                                OS.FileSys.fileSize binname > 0
407                                                handle _ => false
408                                  in                                  in
409                                            (***** busy wait for file to appear;
410                                             * this is obviously very bad! *)
411                                            while not (ready ()) do ()
412                                        end
413                                    in
414                                        OS.FileSys.remove binname handle _ => ();
415                                      youngest := TStamp.NOTSTAMP;                                      youngest := TStamp.NOTSTAMP;
416                                      if compile_there' sp then                                      if compile_there' sp then
417                                          tryload (preceived, compile_again)                                          tryload (sy, received, compile_again)
418                                      else compile_again ()                                      else compile_again ()
419                                  end                                  end
420                              in                              in
# Line 412  Line 425 
425                                   * If the second load also goes wrong, we                                   * If the second load also goes wrong, we
426                                   * compile locally to gather error messages                                   * compile locally to gather error messages
427                                   * and make everything look "normal". *)                                   * and make everything look "normal". *)
428                                  tryload (ploaded, compile)                                  tryload (sy0, loaded, compile)
429                              end (* fromfile *)                              end (* fromfile *)
430                              fun notglobal () =                              fun notglobal () =
431                                  case fromfile () of                                  case fromfile () of
# Line 457  Line 470 
470          end          end
471    
472          fun newTraversal (_, _, GG.ERRORGROUP) =          fun newTraversal (_, _, GG.ERRORGROUP) =
473              { group = fn _ => NONE, exports = SymbolMap.empty }              { group = fn _ => NONE,
474                  allgroups = fn _ => false,
475                  exports = SymbolMap.empty }
476            | newTraversal (notify, storeBFC, g as GG.GROUP grec) = let            | newTraversal (notify, storeBFC, g as GG.GROUP grec) = let
477                  val { exports, ... } = grec                  val { exports, ... } = grec
478                  val um = Memoize.memoize (fn () => Indegree.indegrees g)                  val um = Memoize.memoize (fn () => Indegree.indegrees g)
# Line 468  Line 483 
483                          (fn () =>                          (fn () =>
484                              #impexp                              #impexp
485                                  (mkTraversal (notify, storeBFC, getUrgency)))                                  (mkTraversal (notify, storeBFC, getUrgency)))
486                  fun group gp = let  
487                    fun many (gp, iel) = let
488                      val eo_cl =                      val eo_cl =
489                          map (fn x => Concur.fork (fn () => impexpth () gp x))                          map (fn x => Concur.fork (fn () => impexpth () gp x))
490                              (SymbolMap.listItems exports)                              iel
491                      val eo = foldl (layer'wait 0) (SOME emptyEnv) eo_cl                      val eo = foldl (layer'wait 0) (SOME emptyEnv) eo_cl
492                  in                  in
493                      case eo of                      case eo of
494                          NONE => (Servers.reset false; NONE)                          NONE => (Servers.reset false; NONE)
495                        | SOME e => SOME (#envs e ())                        | SOME e => SOME (#envs e ())
496                  end handle Abort => (Servers.reset false; NONE)                  end handle Abort => (Servers.reset false; NONE)
497    
498                    fun group gp = many (gp, SymbolMap.listItems exports)
499    
500                    fun allgroups gp = let
501                        fun addgroup ((_, th, _), gl) = th () :: gl
502                        fun collect ([], _, l) = l
503                          | collect (GG.ERRORGROUP :: gl, done, l) =
504                            collect (gl, done, l)
505                          | collect (GG.GROUP g :: gl, done, l) =
506                            if SrcPathSet.member (done, #grouppath g) then
507                                collect (gl, done, l)
508                            else
509                                collect (foldl addgroup gl (#sublibs g),
510                                         SrcPathSet.add (done, #grouppath g),
511                                         SymbolMap.foldl (op ::) l (#exports g))
512                        val l = collect ([g], SrcPathSet.empty, [])
513                    in
514                        isSome (many (gp, l))
515                    end
516    
517                  fun mkExport ie gp =                  fun mkExport ie gp =
518                      case impexpth () gp ie handle Abort => NONE of                      case impexpth () gp ie handle Abort => NONE of
519                          NONE => (Servers.reset false; NONE)                          NONE => (Servers.reset false; NONE)
520                        | SOME e => SOME (#envs e ())                        | SOME e => SOME (#envs e ())
521              in              in
522                  { group = group,                  { group = group,
523                      allgroups = allgroups,
524                    exports = SymbolMap.map mkExport exports }                    exports = SymbolMap.map mkExport exports }
525              end              end
526    

Legend:
Removed from v.771  
changed lines
  Added in v.801

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