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 459, Fri Oct 29 06:22:25 1999 UTC revision 460, Wed Nov 3 02:23:44 1999 UTC
# Line 19  Line 19 
19      type statenv = E.staticEnv      type statenv = E.staticEnv
20      type symenv = E.symenv      type symenv = E.symenv
21      type result = { stat: statenv, sym: symenv }      type result = { stat: statenv, sym: symenv }
22      type ed = { ii: IInfo.info, ctxt: statenv }      type ed = IInfo.info
23  in  in
24      signature COMPILE = sig      signature COMPILE = sig
25    
# Line 76  Line 76 
76                sympid: pid }                sympid: pid }
77    
78          type env = { envs: unit -> result, pids: PidSet.set }          type env = { envs: unit -> result, pids: PidSet.set }
79          type envdelta = { ii: IInfo.info, ctxt: unit -> statenv }          type envdelta = IInfo.info
80    
81          type memo =          type memo = { ii: IInfo.info, ts: TStamp.t, cmdata: PidSet.set }
             { ii: IInfo.info, ctxt: statenv, ts: TStamp.t, cmdata: PidSet.set }  
82    
83          (* persistent state! *)          (* persistent state! *)
84          val filtermap = ref (FilterMap.empty: pid FilterMap.map)          val filtermap = ref (FilterMap.empty: pid FilterMap.map)
# Line 98  Line 97 
97    
98          fun memo2ii (memo: memo) = #ii memo          fun memo2ii (memo: memo) = #ii memo
99    
100          fun memo2ed memo = { ii = memo2ii memo, ctxt = fn () => #ctxt memo }          fun memo2ed memo = memo2ii memo
101    
102          fun bfc2memo (bfc, ctxt, ts) = let          fun bfc2memo (bfc, ts) = let
103              val ii = { statenv = fn () => BF.senvOf bfc,              val ii = { statenv = fn () => BF.senvOf bfc,
104                         symenv = fn () => BF.symenvOf bfc,                         symenv = fn () => BF.symenvOf bfc,
105                         statpid = BF.staticPidOf bfc,                         statpid = BF.staticPidOf bfc,
106                         sympid = BF.lambdaPidOf bfc }                         sympid = BF.lambdaPidOf bfc }
107              val cmdata = PidSet.addList (PidSet.empty, BF.cmDataOf bfc)              val cmdata = PidSet.addList (PidSet.empty, BF.cmDataOf bfc)
108          in          in
109              { ii = ii, ctxt = ctxt, ts = ts, cmdata = cmdata }              { ii = ii, ts = ts, cmdata = cmdata }
110          end          end
111    
112          fun pidset (p1, p2) = PidSet.add (PidSet.singleton p1, p2)          fun pidset (p1, p2) = PidSet.add (PidSet.singleton p1, p2)
113    
114          fun nofilter (ed: envdelta) = let          fun nofilter (ed: envdelta) = let
115              val { ii = { statenv, symenv, statpid, sympid }, ctxt } = ed              val { statenv, symenv, statpid, sympid } = ed
116          in          in
117              { envs = fn () => { stat = statenv (), sym = symenv () },              { envs = fn () => { stat = statenv (), sym = symenv () },
118                pids = pidset (statpid, sympid) }                pids = pidset (statpid, sympid) }
# Line 122  Line 121 
121          fun exportsNothingBut set se =          fun exportsNothingBut set se =
122              List.all (fn sy => SymbolSet.member (set, sy)) (E.catalogEnv se)              List.all (fn sy => SymbolSet.member (set, sy)) (E.catalogEnv se)
123    
124          fun filter ({ ii, ctxt }: envdelta, s) = let          fun filter (ii, s) = let
125              val { statenv, symenv, statpid, sympid } = ii              val { statenv, symenv, statpid, sympid } = ii
126              val ste = statenv ()              val ste = statenv ()
127          in          in
# Line 136  Line 135 
135                      case FilterMap.find (!filtermap, key) of                      case FilterMap.find (!filtermap, key) of
136                          SOME statpid' => statpid'                          SOME statpid' => statpid'
137                        | NONE => let                        | NONE => let
138                                (* We re-pickle the filtered ste relative to
139                                 * the original one.  This should give a fairly
140                                 * minimal pickle. *)
141                              val statpid' =                              val statpid' =
142                                  GenericVC.MakePid.makePid (ctxt (), ste')                                  GenericVC.MakePid.makePid (ste, ste')
143                          in                          in
144                              filtermap :=                              filtermap :=
145                                FilterMap.insert (!filtermap, key, statpid');                                FilterMap.insert (!filtermap, key, statpid');
# Line 200  Line 202 
202                          (* The beauty of this scheme is that we don't have                          (* The beauty of this scheme is that we don't have
203                           * to do anything at all for SB_BNODEs:  Everything                           * to do anything at all for SB_BNODEs:  Everything
204                           * is prepared ready to be used when the library                           * is prepared ready to be used when the library
205                           * is unpickled.                           * is unpickled. *)
206                           *                          SOME ii
                          * Making ctxt equal to ste is basically a hack  
                          * because we want to avoid having to keep the  
                          * real context around.  As a result there is a  
                          * slight loss of "smart recompilation":  
                          * eliminating a definition is not the same as  
                          * stripping it away using a filter.  This is a  
                          * minor issue anyway, and in the present case  
                          * it only happens when a stable library is  
                          * replaced by a different one. *)  
                         SOME { ii = ii, ctxt = #statenv ii }  
207                    | DG.SB_SNODE n =>                    | DG.SB_SNODE n =>
208                          (case snode gp n of                          (case snode gp n of
209                               NONE => NONE                               NONE => NONE
210                             | SOME { ii, ... } =>                             | SOME ii => SOME ii)
                                  (* Now, unfortunately, because of the  
                                   * hack above (ctxt = ste) we must  
                                   * do the same thing here or we end up  
                                   * not being consistent. *)  
                                  SOME { ii = ii, ctxt = #statenv ii })  
211    
212              and fsbnode gp (f, n) =              and fsbnode gp (f, n) =
213                  case (sbnode gp n, f) of                  case (sbnode gp n, f) of
# Line 274  Line 261 
261                                                    senv = stat,                                                    senv = stat,
262                                                    symenv = sym,                                                    symenv = sym,
263                                                    corenv = corenv }                                                    corenv = corenv }
264                              val memo = bfc2memo (bfc, stat, SmlInfo.lastseen i)                              val memo = bfc2memo (bfc, SmlInfo.lastseen i)
265                          in                          in
266                              save bfc;                              save bfc;
267                              storeBFC (i, bfc);                              storeBFC (i, bfc);
268                              SOME memo                              SOME memo
269                          end                          end handle _ => NONE (* catch elaborator exn *)
270                  end (* compile_here *)                  end (* compile_here *)
271                  fun notlocal () = let                  fun notlocal () = let
272                      val urgency = getUrgency i                      val urgency = getUrgency i
# Line 327  Line 314 
314                                      case load () of                                      case load () of
315                                          NONE => otherwise ()                                          NONE => otherwise ()
316                                        | SOME (bfc, ts) => let                                        | SOME (bfc, ts) => let
317                                              val memo = bfc2memo (bfc, stat, ts)                                              val memo = bfc2memo (bfc, ts)
318                                          in                                          in
319                                              if isValidMemo (memo, pids, i) then                                              if isValidMemo (memo, pids, i) then
320                                                  (Say.vsay ["[", binname,                                                  (Say.vsay ["[", binname,
# Line 429  Line 416 
416              val { sbnode, ... } = mkTraversal (fn _ => fn _ => (),              val { sbnode, ... } = mkTraversal (fn _ => fn _ => (),
417                                                 fn _ => (),                                                 fn _ => (),
418                                                 fn _ => 0)                                                 fn _ => 0)
             fun envdelta2ed { ii, ctxt } = { ii = ii, ctxt = ctxt () }  
419          in          in
420              fn gp => fn n => Option.map envdelta2ed (sbnode gp n)              sbnode
421          end          end
422    
423          fun evict i =          fun evict i =

Legend:
Removed from v.459  
changed lines
  Added in v.460

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