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 1057, Fri Feb 8 17:31:02 2002 UTC revision 1058, Fri Feb 8 20:02:56 2002 UTC
# Line 80  Line 80 
80                        | unequal => unequal                        | unequal => unequal
81              end)              end)
82    
         type bfinfo =  
             { cmdata: PidSet.set,  
               statenv: unit -> statenv,  
               symenv: unit -> symenv,  
               statpid: pid,  
               sympid: pid }  
   
83          type env = { envs: unit -> result, pids: PidSet.set }          type env = { envs: unit -> result, pids: PidSet.set }
84          type envdelta = IInfo.info          type envdelta = IInfo.info
85    
# Line 128  Line 121 
121              val ii = { statenv = Memoize.memoize statenv,              val ii = { statenv = Memoize.memoize statenv,
122                         symenv = Memoize.memoize symenv,                         symenv = Memoize.memoize symenv,
123                         statpid = BF.staticPidOf bfc,                         statpid = BF.staticPidOf bfc,
124                         sympid = BF.lambdaPidOf bfc }                         sympid = BF.lambdaPidOf bfc,
125                           pepper = BF.pepperOf bfc }
126              val cmdata = PidSet.addList (PidSet.empty, BF.cmDataOf bfc)              val cmdata = PidSet.addList (PidSet.empty, BF.cmDataOf bfc)
127          in          in
128              { ii = ii, ts = ts, cmdata = cmdata }              { ii = ii, ts = ts, cmdata = cmdata }
# Line 137  Line 131 
131          fun pidset (p1, p2) = PidSet.add (PidSet.singleton p1, p2)          fun pidset (p1, p2) = PidSet.add (PidSet.singleton p1, p2)
132    
133          fun nofilter (ed: envdelta) = let          fun nofilter (ed: envdelta) = let
134              val { statenv, symenv, statpid, sympid } = ed              val { statenv, symenv, statpid, sympid, pepper } = ed
135              val statenv' = Memoize.memoize statenv              val statenv' = Memoize.memoize statenv
136          in          in
137              { envs = fn () => { stat = statenv' (), sym = symenv () },              { envs = fn () => { stat = statenv' (), sym = symenv () },
# Line 154  Line 148 
148          end          end
149    
150          fun filter (ii, s) = let          fun filter (ii, s) = let
151              val { statenv, symenv, statpid, sympid } = ii              val { statenv, symenv, statpid, sympid, pepper } = ii
152              val ste = statenv ()              val ste = statenv ()
153          in          in
154              case requiredFiltering s ste of              case requiredFiltering s ste of
# Line 168  Line 162 
162                              SOME statpid' => statpid'                              SOME statpid' => statpid'
163                            | NONE => let                            | NONE => let
164                                  val statpid' = Rehash.rehash                                  val statpid' = Rehash.rehash
165                                          { env = ste', orig_hash = statpid }                                          { env = ste', orig_pid = statpid,
166                                              pepper = pepper }
167                              in                              in
168                                  filtermap :=                                  filtermap :=
169                                    FilterMap.insert (!filtermap, key, statpid');                                    FilterMap.insert (!filtermap, key, statpid');
# Line 214  Line 209 
209          fun mkTraversal (notify, storeBFC, getUrgency) = let          fun mkTraversal (notify, storeBFC, getUrgency) = let
210              val localstate = ref SmlInfoMap.empty              val localstate = ref SmlInfoMap.empty
211    
212                fun storeBFC' (gp, i, x) = let
213                    val src = SmlInfo.sourcepath i
214                    val c = #contents x
215                    val triplet = { staticPid = BF.staticPidOf c,
216                                    fingerprint = BF.fingerprintOf c,
217                                    pepper = BF.pepperOf c }
218                in
219                    UniquePid.saveInfo gp src triplet;
220                    storeBFC (i, x)
221                end
222    
223    
224              fun sbnode gp (DG.SB_SNODE n) = snode gp n              fun sbnode gp (DG.SB_SNODE n) = snode gp n
225                (* The beauty of this scheme is that we don't have                (* The beauty of this scheme is that we don't have
226                 * to do anything at all for SB_BNODEs:  Everything                 * to do anything at all for SB_BNODEs:  Everything
# Line 257  Line 264 
264                  fun fail () =                  fun fail () =
265                      if #keep_going (#param gp) then NONE else raise Abort                      if #keep_going (#param gp) then NONE else raise Abort
266    
267                  fun compile_here (stat, sym, pids, split) = let                  fun compile_here (stat, sym, pids, split, fpinfo) = let
268                      fun perform_setup _ NONE = ()                      fun perform_setup _ NONE = ()
269                        | perform_setup what (SOME code) =                        | perform_setup what (SOME code) =
270                          (Say.vsay ["[setup (", what, "): ", code, "]\n"];                          (Say.vsay ["[setup (", what, "): ", code, "]\n"];
# Line 320  Line 327 
327                              val cinfo = C.mkCompInfo { source = source,                              val cinfo = C.mkCompInfo { source = source,
328                                                         transform = fn x => x }                                                         transform = fn x => x }
329                              val splitting = Control.LambdaSplitting.get' split                              val splitting = Control.LambdaSplitting.get' split
330                                val uniquepid = UniquePid.uniquepid fpinfo
331                              val { csegments, newstatenv, exportPid,                              val { csegments, newstatenv, exportPid,
332                                    staticPid, imports, pickle = senvP,                                    staticPid, fingerprint, pepper,
333                                      imports, pickle = senvP,
334                                    inlineExp, ... } =                                    inlineExp, ... } =
335                                  C.compile { source = source, ast = ast,                                  C.compile { source = source, ast = ast,
336                                              statenv = stat, symenv = sym,                                              statenv = stat, symenv = sym,
337                                              compInfo = cinfo, checkErr = check,                                              compInfo = cinfo, checkErr = check,
338                                              splitting = splitting }                                              splitting = splitting,
339                                                uniquepid = uniquepid }
340                              val { hash = lambdaPid, pickle = lambdaP } =                              val { hash = lambdaPid, pickle = lambdaP } =
341                                  PickMod.pickleFLINT inlineExp                                  PickMod.pickleFLINT inlineExp
342                              val lambdaP = case inlineExp of                              val lambdaP = case inlineExp of
# Line 340  Line 350 
350                                                   pid = staticPid },                                                   pid = staticPid },
351                                          lambda = { pickle = lambdaP,                                          lambda = { pickle = lambdaP,
352                                                     pid = lambdaPid },                                                     pid = lambdaPid },
353                                            fingerprint = fingerprint,
354                                            pepper = pepper,
355                                          csegments = csegments }                                          csegments = csegments }
356                              val memo =                              val memo =
357                                  bfc2memo (bfc, SmlInfo.lastseen i, stat)                                  bfc2memo (bfc, SmlInfo.lastseen i, stat)
358                          in                          in
359                              perform_setup "post" post;                              perform_setup "post" post;
360                              #set topLevel toplenv;                              #set topLevel toplenv;
361                              storeBFC (i, { contents = bfc, stats = save bfc });                              storeBFC' (gp, i,
362                                           { contents = bfc, stats = save bfc });
363                              SOME memo                              SOME memo
364                          end handle (EM.Error | CompileExn.Compile _)                          end handle (EM.Error | CompileExn.Compile _)
365                                     (* At this point we handle only                                     (* At this point we handle only
# Line 422  Line 435 
435                                          in                                          in
436                                              if isValidMemo (memo, pids, i) then                                              if isValidMemo (memo, pids, i) then
437                                                  (report stats;                                                  (report stats;
438                                                   storeBFC (i, contst);                                                   storeBFC' (gp, i, contst);
439                                                   SOME memo)                                                   SOME memo)
440                                              else otherwise ()                                              else otherwise ()
441                                          end                                          end
# Line 431  Line 444 
444                                      (* Are we the only runable task? *)                                      (* Are we the only runable task? *)
445                                      Servers.allIdle () andalso                                      Servers.allIdle () andalso
446                                      Concur.noTasks ()                                      Concur.noTasks ()
447                                  fun compile_again () =                                  fun compile_again fpinfo () =
448                                      (Say.vsay ["[compiling ", descr, "]\n"];                                      (Say.vsay ["[compiling ", descr, "]\n"];
449                                       compile_here (stat, sym, pids, split))                                       compile_here (stat, sym, pids, split,
450                                                       fpinfo))
451                                  fun compile_there' p =                                  fun compile_there' p =
452                                      not (bottleneck ()) andalso                                      not (bottleneck ()) andalso
453                                      compile_there p                                      compile_there p
# Line 448  Line 462 
462                                           * this is obviously very bad! *)                                           * this is obviously very bad! *)
463                                          while not (ready ()) do ()                                          while not (ready ()) do ()
464                                      end                                      end
465                                        val fpinfo = UniquePid.getInfo gp sp
466                                        val compile_again = compile_again fpinfo
467                                  in                                  in
468                                      OS.FileSys.remove binname handle _ => ();                                      OS.FileSys.remove binname handle _ => ();
469                                      youngest := TStamp.NOTSTAMP;                                      youngest := TStamp.NOTSTAMP;
# Line 533  Line 549 
549                        | SOME e => SOME (#envs e ())                        | SOME e => SOME (#envs e ())
550                  end handle Abort => (Servers.reset false; NONE)                  end handle Abort => (Servers.reset false; NONE)
551    
552                  fun group gp = many (gp, SymbolMap.listItems exports)                  fun group gp =
553                        (UniquePid.reset ();
554                         many (gp, SymbolMap.listItems exports)
555                         before UniquePid.sync gp)
556    
557                  fun allgroups gp = let                  fun allgroups gp = let
558                      fun addgroup ((_, th, _), gl) = th () :: gl                      fun addgroup ((_, th, _), gl) = th () :: gl
# Line 547  Line 566 
566                              collect (foldl addgroup gl (#sublibs g),                              collect (foldl addgroup gl (#sublibs g),
567                                       SrcPathSet.add (done, #grouppath g),                                       SrcPathSet.add (done, #grouppath g),
568                                       SymbolMap.foldl (op ::) l (#exports g))                                       SymbolMap.foldl (op ::) l (#exports g))
569                        val _ = UniquePid.reset ()
570                      val l = collect ([g], SrcPathSet.empty, [])                      val l = collect ([g], SrcPathSet.empty, [])
571                  in                  in
572                      isSome (many (gp, l))                      isSome (many (gp, l))
573                        before UniquePid.sync gp
574                  end                  end
575    
576                  fun mkExport ie gp =                  fun mkExport ie gp =

Legend:
Removed from v.1057  
changed lines
  Added in v.1058

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