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

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