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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 297 - (view) (download)

1 : blume 295 (*
2 :     * Build a new "full" persistent state.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 :     functor FullPersstateFn (structure MachDepVC : MACHDEP_VC) :> FULL_PERSSTATE =
9 :     struct
10 :     local
11 :     structure RecompPersstate =
12 :     RecompPersstateFn (structure MachDepVC = MachDepVC
13 :     val discard_code = false)
14 :     in
15 :     open RecompPersstate
16 :    
17 :     structure E = GenericVC.Environment
18 :     structure DTS = DynTStamp
19 :    
20 : blume 297 infix o' o''
21 : blume 295 fun (f o' g) (x, y) = f (g x, y)
22 : blume 297 fun (f o'' g) (x, y, z) = f (g x, y, z)
23 : blume 295
24 :     type exec_memo = { dyn: E.dynenv, dts: DTS.dts }
25 :    
26 :     val smlmap = ref (AbsPathMap.empty: exec_memo AbsPathMap.map)
27 :     val stablemap = ref (StableMap.empty: exec_memo StableMap.map)
28 :    
29 :     datatype key =
30 :     SML of SmlInfo.info
31 :     | STABLE of BinInfo.info
32 :    
33 :     fun find (SML i) = AbsPathMap.find (!smlmap, SmlInfo.sourcepath i)
34 :     | find (STABLE i) = StableMap.find (!stablemap, i)
35 :    
36 :     fun insert (SML i, m) =
37 :     smlmap := AbsPathMap.insert (!smlmap, SmlInfo.sourcepath i, m)
38 :     | insert (STABLE i, m) =
39 :     stablemap := StableMap.insert (!stablemap, i, m)
40 :    
41 :     fun remove (SML i) =
42 :     smlmap := #1 (AbsPathMap.remove (!smlmap,
43 :     SmlInfo.sourcepath i))
44 :     | remove (STABLE i) =
45 :     stablemap := #1 (StableMap.remove (!stablemap, i))
46 :    
47 :     fun share (SML i) = SmlInfo.share i
48 :     | share (STABLE i) = BinInfo.share i
49 :    
50 : blume 297 fun error gp (SML i) = SmlInfo.error gp i
51 :     | error gp (STABLE i) = BinInfo.error gp i
52 : blume 295
53 : blume 297 fun exec_look (i, s, gp) =
54 : blume 295 case find i of
55 :     NONE => NONE
56 :     | SOME (memo as { dts = s', ... }) => let
57 :     fun warn () =
58 : blume 297 error gp i GenericVC.ErrorMsg.WARN
59 : blume 295 "re-instantiation (sharing may be lost)"
60 :     GenericVC.ErrorMsg.nullErrorBody
61 :     in
62 :     if DTS.outdated { context = s, oldresult = s' } then
63 :     (if share i = SOME true then warn () else ();
64 :     (remove i; NONE))
65 :     else SOME memo
66 :     end
67 :    
68 :     fun exec_memo (i, memo) =
69 :     if share i = SOME false then () else insert (i, memo)
70 :    
71 : blume 297 val exec_look_sml = exec_look o'' SML
72 :     val exec_look_stable = exec_look o'' STABLE
73 : blume 295 val exec_memo_sml = exec_memo o' SML
74 :     val exec_memo_stable = exec_memo o' STABLE
75 :     end
76 :     end

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