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 360 - (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 360 local
9 :     structure Pid = GenericVC.PersStamps
10 :     type pid = Pid.persstamp
11 :     in
12 : blume 301 functor RecompPersstateFn
13 :     (structure MachDepVC : MACHDEP_VC
14 : blume 360 val new_smlinfo : SmlInfo.info * pid option -> unit
15 :     val discard_code : bool) :> RECOMP_PERSSTATE = struct
16 : blume 301
17 : blume 295 structure MachDepVC = MachDepVC
18 :     structure BF = MachDepVC.Binfile
19 :     structure E = GenericVC.Environment
20 :    
21 :     type recomp_memo = { bfc: BF.bfContent, ctxt: E.staticEnv }
22 : blume 301 type recomp_tmemo = recomp_memo * TStamp.t
23 : blume 295
24 : blume 305 val smlmap = ref (SmlInfoMap.empty: recomp_tmemo SmlInfoMap.map)
25 : blume 295 val stablemap = ref (StableMap.empty: recomp_memo StableMap.map)
26 :    
27 : blume 297 fun recomp_look_sml (i, provided, gp) = let
28 : blume 301 fun isValid ({ bfc, ctxt }, ts) =
29 : blume 345 not (TStamp.needsUpdate { source = SmlInfo.lastseen i,
30 :     target = ts })
31 : blume 301 andalso let
32 :     val demanded =
33 :     PidSet.addList (PidSet.empty, BF.cmDataOf bfc)
34 :     in
35 :     PidSet.equal (provided, demanded)
36 :     end
37 : blume 295 in
38 : blume 305 case SmlInfoMap.find (!smlmap, i) of
39 : blume 295 NONE => NONE
40 : blume 301 | SOME (memo, ts) =>
41 :     if isValid (memo, ts) then SOME memo
42 : blume 305 else (smlmap := #1 (SmlInfoMap.remove (!smlmap, i));
43 : blume 295 NONE)
44 :     end
45 :    
46 : blume 301 fun recomp_memo_sml0 (i, memo) = let
47 :     val ts = SmlInfo.lastseen i
48 :     val tmemo = (memo, ts)
49 :     in
50 : blume 360 new_smlinfo (i, BF.exportPidOf (#bfc memo));
51 : blume 305 smlmap := SmlInfoMap.insert (!smlmap, i, tmemo)
52 : blume 301 end
53 : blume 295
54 :     val recomp_memo_sml =
55 : blume 320 if discard_code then
56 :     (fn x => (BF.discardCode (#bfc (#2 x)); recomp_memo_sml0 x))
57 : blume 295 else recomp_memo_sml0
58 :    
59 :     fun recomp_look_stable i = StableMap.find (!stablemap, i)
60 :     fun recomp_memo_stable0 (i, memo) =
61 :     stablemap := StableMap.insert (!stablemap, i, memo)
62 :    
63 :     val recomp_memo_stable =
64 : blume 320 if discard_code then
65 :     (fn x => (BF.discardCode (#bfc (#2 x)); recomp_memo_stable0 x))
66 : blume 295 else recomp_memo_stable0
67 :    
68 : blume 305 fun bfc_fetch_sml i = #bfc (#1 (valOf (SmlInfoMap.find (!smlmap, i))))
69 : blume 355 handle Option => raise Fail "bfc_fetch_sml"
70 : blume 305 fun bfc_fetch_stable i = #bfc (valOf (StableMap.find (!stablemap, i)))
71 : blume 355 handle Option => raise Fail "bfc_fetch_stable"
72 : blume 357
73 :     val pid_fetch_sml = BF.exportPidOf o bfc_fetch_sml
74 : blume 295 end
75 : blume 360 end

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