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/recomp-persstate-fn.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/compile/recomp-persstate-fn.sml

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

revision 297, Thu May 27 08:29:19 1999 UTC revision 301, Fri May 28 09:43:39 1999 UTC
# Line 5  Line 5 
5   *   *
6   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7   *)   *)
8  functor RecompPersstateFn (structure MachDepVC : MACHDEP_VC  functor RecompPersstateFn
9                             val discard_code : bool) :> RECOMP_PERSSTATE =      (structure MachDepVC : MACHDEP_VC
10      struct       val discard_code : bool
11         val discard_value : SmlInfo.info -> unit) :> RECOMP_PERSSTATE = struct
12    
13          structure MachDepVC = MachDepVC          structure MachDepVC = MachDepVC
14          structure BF = MachDepVC.Binfile          structure BF = MachDepVC.Binfile
15          structure E = GenericVC.Environment          structure E = GenericVC.Environment
16    
17          type recomp_memo = { bfc: BF.bfContent, ctxt: E.staticEnv }          type recomp_memo = { bfc: BF.bfContent, ctxt: E.staticEnv }
18            type recomp_tmemo = recomp_memo * TStamp.t
19    
20          val smlmap = ref (AbsPathMap.empty: recomp_memo AbsPathMap.map)          val smlmap = ref (AbsPathMap.empty: recomp_tmemo AbsPathMap.map)
21          val stablemap = ref (StableMap.empty: recomp_memo StableMap.map)          val stablemap = ref (StableMap.empty: recomp_memo StableMap.map)
22    
23          fun recomp_look_sml (i, provided, gp) = let          fun recomp_look_sml (i, provided, gp) = let
24              fun isValid { bfc, ctxt } = let              fun isValid ({ bfc, ctxt }, ts) =
25                  val demanded = PidSet.addList (PidSet.empty, BF.cmDataOf bfc)                  not (TStamp.earlier (ts, SmlInfo.lastseen i))
26                    andalso let
27                        val demanded =
28                            PidSet.addList (PidSet.empty, BF.cmDataOf bfc)
29              in              in
30                  PidSet.equal (provided, demanded)                  PidSet.equal (provided, demanded)
31              end              end
# Line 27  Line 33 
33          in          in
34              case AbsPathMap.find (!smlmap, p) of              case AbsPathMap.find (!smlmap, p) of
35                  NONE => NONE                  NONE => NONE
36                | SOME memo =>                | SOME (memo, ts) =>
37                      if isValid memo then SOME memo                      if isValid (memo, ts) then SOME memo
38                      else (smlmap := #1 (AbsPathMap.remove (!smlmap, p));                      else (smlmap := #1 (AbsPathMap.remove (!smlmap, p));
39                            NONE)                            NONE)
40          end          end
41    
42          fun recomp_memo_sml0 (i, memo) =          fun recomp_memo_sml0 (i, memo) = let
43              smlmap := AbsPathMap.insert (!smlmap, SmlInfo.sourcepath i, memo)              val ts = SmlInfo.lastseen i
44                val tmemo = (memo, ts)
45            in
46                discard_value i;
47                smlmap := AbsPathMap.insert (!smlmap, SmlInfo.sourcepath i, tmemo)
48            end
49    
50          fun discard (arg as (_, { bfc, ctxt })) = (BF.discardCode bfc; arg)          fun discard (arg as (_, { bfc, ctxt })) = (BF.discardCode bfc; arg)
51    
# Line 51  Line 62 
62              else recomp_memo_stable0              else recomp_memo_stable0
63    
64          fun bfc_fetch_sml i =          fun bfc_fetch_sml i =
65              #bfc (valOf (AbsPathMap.find (!smlmap, SmlInfo.sourcepath i)))              #bfc (#1 (valOf (AbsPathMap.find (!smlmap, SmlInfo.sourcepath i))))
66          fun bfc_fetch_stable i =          fun bfc_fetch_stable i =
67              #bfc (valOf (StableMap.find (!stablemap, i)))              #bfc (valOf (StableMap.find (!stablemap, i)))
68      end      end

Legend:
Removed from v.297  
changed lines
  Added in v.301

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