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 1136, Tue Mar 12 19:44:02 2002 UTC revision 1137, Tue Mar 12 22:28:55 2002 UTC
# Line 122  Line 122 
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 }                         guid = BF.guidOf 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 131  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, pepper } = ed              val { statenv, symenv, statpid, sympid, guid } = 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 148  Line 148 
148          end          end
149    
150          fun filter (ii, s) = let          fun filter (ii, s) = let
151              val { statenv, symenv, statpid, sympid, pepper } = ii              val { statenv, symenv, statpid, sympid, guid } = ii
152              val ste = statenv ()              val ste = statenv ()
153          in          in
154              case requiredFiltering s ste of              case requiredFiltering s ste of
# Line 163  Line 163 
163                            | NONE => let                            | NONE => let
164                                  val statpid' = Rehash.rehash                                  val statpid' = Rehash.rehash
165                                          { env = ste', orig_pid = statpid,                                          { env = ste', orig_pid = statpid,
166                                            pepper = pepper }                                            guid = guid }
167                              in                              in
168                                  filtermap :=                                  filtermap :=
169                                    FilterMap.insert (!filtermap, key, statpid');                                    FilterMap.insert (!filtermap, key, statpid');
# Line 212  Line 212 
212              fun storeBFC' (gp, i, x) = let              fun storeBFC' (gp, i, x) = let
213                  val src = SmlInfo.sourcepath i                  val src = SmlInfo.sourcepath i
214                  val c = #contents x                  val c = #contents x
                 val triplet = { staticPid = BF.staticPidOf c,  
                                 fingerprint = BF.fingerprintOf c,  
                                 pepper = BF.pepperOf c }  
215              in              in
                 UniquePid.saveInfo gp src triplet;  
216                  storeBFC (i, x)                  storeBFC (i, x)
217              end              end
218    
# Line 264  Line 260 
260                  fun fail () =                  fun fail () =
261                      if #keep_going (#param gp) then NONE else raise Abort                      if #keep_going (#param gp) then NONE else raise Abort
262    
263                  fun compile_here (stat, sym, pids, split, fpinfo) = let                  fun compile_here (stat, sym, pids, split) = let
264                      fun perform_setup _ NONE = ()                      fun perform_setup _ NONE = ()
265                        | perform_setup what (SOME code) =                        | perform_setup what (SOME code) =
266                          (Say.vsay ["[setup (", what, "): ", code, "]\n"];                          (Say.vsay ["[setup (", what, "): ", code, "]\n"];
# Line 327  Line 323 
323                              val cinfo = C.mkCompInfo { source = source,                              val cinfo = C.mkCompInfo { source = source,
324                                                         transform = fn x => x }                                                         transform = fn x => x }
325                              val splitting = Control.LambdaSplitting.get' split                              val splitting = Control.LambdaSplitting.get' split
326                              val uniquepid = UniquePid.uniquepid fpinfo                              val guid = SmlInfo.guid i
327                              val { csegments, newstatenv, exportPid,                              val { csegments, newstatenv, exportPid,
328                                    staticPid, fingerprint, pepper,                                    staticPid, imports, pickle = senvP,
                                   imports, pickle = senvP,  
329                                    inlineExp, ... } =                                    inlineExp, ... } =
330                                  C.compile { source = source, ast = ast,                                  C.compile { source = source, ast = ast,
331                                              statenv = stat, symenv = sym,                                              statenv = stat, symenv = sym,
332                                              compInfo = cinfo, checkErr = check,                                              compInfo = cinfo, checkErr = check,
333                                              splitting = splitting,                                              splitting = splitting,
334                                              uniquepid = uniquepid }                                              guid = guid }
335                              val { hash = lambdaPid, pickle = lambdaP } =                              val { hash = lambdaPid, pickle = lambdaP } =
336                                  PickMod.pickleFLINT inlineExp                                  PickMod.pickleFLINT inlineExp
337                              val lambdaP = case inlineExp of                              val lambdaP = case inlineExp of
# Line 350  Line 345 
345                                                   pid = staticPid },                                                   pid = staticPid },
346                                          lambda = { pickle = lambdaP,                                          lambda = { pickle = lambdaP,
347                                                     pid = lambdaPid },                                                     pid = lambdaPid },
348                                          fingerprint = fingerprint,                                          guid = guid,
                                         pepper = pepper,  
349                                          csegments = csegments }                                          csegments = csegments }
350                              val memo =                              val memo =
351                                  bfc2memo (bfc, SmlInfo.lastseen i, stat)                                  bfc2memo (bfc, SmlInfo.lastseen i, stat)
# Line 415  Line 409 
409                                                        version = version,                                                        version = version,
410                                                        stream = s }                                                        stream = s }
411                                      in                                      in
412                                            SmlInfo.setguid (i, BF.guidOf contents);
413                                          (contents, ts, stats)                                          (contents, ts, stats)
414                                      end                                      end
415                                  in                                  in
# Line 444  Line 439 
439                                      (* Are we the only runable task? *)                                      (* Are we the only runable task? *)
440                                      Servers.allIdle () andalso                                      Servers.allIdle () andalso
441                                      Concur.noTasks ()                                      Concur.noTasks ()
442                                  fun compile_again fpinfo () =                                  fun compile_again () =
443                                      (Say.vsay ["[compiling ", descr, "]\n"];                                      (Say.vsay ["[compiling ", descr, "]\n"];
444                                       compile_here (stat, sym, pids, split,                                       compile_here (stat, sym, pids, split))
                                                    fpinfo))  
445                                  fun compile_there' p =                                  fun compile_there' p =
446                                      not (bottleneck ()) andalso                                      not (bottleneck ()) andalso
447                                      compile_there p                                      compile_there p
# Line 462  Line 456 
456                                           * this is obviously very bad! *)                                           * this is obviously very bad! *)
457                                          while not (ready ()) do ()                                          while not (ready ()) do ()
458                                      end                                      end
                                     val fpinfo = UniquePid.getInfo gp sp  
                                     val compile_again = compile_again fpinfo  
459                                  in                                  in
460                                      OS.FileSys.remove binname handle _ => ();                                      OS.FileSys.remove binname handle _ => ();
461                                      youngest := TStamp.NOTSTAMP;                                      youngest := TStamp.NOTSTAMP;
# Line 549  Line 541 
541                        | SOME e => SOME (#envs e ())                        | SOME e => SOME (#envs e ())
542                  end handle Abort => (Servers.reset false; NONE)                  end handle Abort => (Servers.reset false; NONE)
543    
544                  fun group gp =                  fun group gp = many (gp, SymbolMap.listItems exports)
                     (UniquePid.reset ();  
                      many (gp, SymbolMap.listItems exports)  
                      before UniquePid.sync gp)  
545    
546                  fun allgroups gp = let                  fun allgroups gp = let
547                      fun addgroup ((_, th, _), gl) = th () :: gl                      fun addgroup ((_, th, _), gl) = th () :: gl
# Line 566  Line 555 
555                              collect (foldl addgroup gl (#sublibs g),                              collect (foldl addgroup gl (#sublibs g),
556                                       SrcPathSet.add (done, #grouppath g),                                       SrcPathSet.add (done, #grouppath g),
557                                       SymbolMap.foldl (op ::) l (#exports g))                                       SymbolMap.foldl (op ::) l (#exports g))
                     val _ = UniquePid.reset ()  
558                      val l = collect ([g], SrcPathSet.empty, [])                      val l = collect ([g], SrcPathSet.empty, [])
559                  in                  in
560                      isSome (many (gp, l))                      isSome (many (gp, l))
                     before UniquePid.sync gp  
561                  end                  end
562    
563                  fun mkExport ie gp =                  fun mkExport ie gp =

Legend:
Removed from v.1136  
changed lines
  Added in v.1137

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