Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/compile/recomp-persstate-fn.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 301 - (view) (download)

1 : blume 295 (*
2 :     * Build a new "recompilation-related" persistent state.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 : blume 301 functor RecompPersstateFn
9 :     (structure MachDepVC : MACHDEP_VC
10 :     val discard_code : bool
11 :     val discard_value : SmlInfo.info -> unit) :> RECOMP_PERSSTATE = struct
12 :    
13 : blume 295 structure MachDepVC = MachDepVC
14 :     structure BF = MachDepVC.Binfile
15 :     structure E = GenericVC.Environment
16 :    
17 :     type recomp_memo = { bfc: BF.bfContent, ctxt: E.staticEnv }
18 : blume 301 type recomp_tmemo = recomp_memo * TStamp.t
19 : blume 295
20 : blume 301 val smlmap = ref (AbsPathMap.empty: recomp_tmemo AbsPathMap.map)
21 : blume 295 val stablemap = ref (StableMap.empty: recomp_memo StableMap.map)
22 :    
23 : blume 297 fun recomp_look_sml (i, provided, gp) = let
24 : blume 301 fun isValid ({ bfc, ctxt }, ts) =
25 :     not (TStamp.earlier (ts, SmlInfo.lastseen i))
26 :     andalso let
27 :     val demanded =
28 :     PidSet.addList (PidSet.empty, BF.cmDataOf bfc)
29 :     in
30 :     PidSet.equal (provided, demanded)
31 :     end
32 : blume 295 val p = SmlInfo.sourcepath i
33 :     in
34 :     case AbsPathMap.find (!smlmap, p) of
35 :     NONE => NONE
36 : blume 301 | SOME (memo, ts) =>
37 :     if isValid (memo, ts) then SOME memo
38 : blume 295 else (smlmap := #1 (AbsPathMap.remove (!smlmap, p));
39 :     NONE)
40 :     end
41 :    
42 : blume 301 fun recomp_memo_sml0 (i, memo) = let
43 :     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 : blume 295
50 :     fun discard (arg as (_, { bfc, ctxt })) = (BF.discardCode bfc; arg)
51 :    
52 :     val recomp_memo_sml =
53 :     if discard_code then recomp_memo_sml0 o discard
54 :     else recomp_memo_sml0
55 :    
56 :     fun recomp_look_stable i = StableMap.find (!stablemap, i)
57 :     fun recomp_memo_stable0 (i, memo) =
58 :     stablemap := StableMap.insert (!stablemap, i, memo)
59 :    
60 :     val recomp_memo_stable =
61 :     if discard_code then recomp_memo_stable0 o discard
62 :     else recomp_memo_stable0
63 :    
64 :     fun bfc_fetch_sml i =
65 : blume 301 #bfc (#1 (valOf (AbsPathMap.find (!smlmap, SmlInfo.sourcepath i))))
66 : blume 295 fun bfc_fetch_stable i =
67 :     #bfc (valOf (StableMap.find (!stablemap, i)))
68 :     end

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