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 |
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 |
|
|
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 |