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 354 - (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 : blume 301 structure E = GenericVC.Environment
11 : blume 320 structure EM = GenericVC.ErrorMsg
12 :     structure PP = PrettyPrint
13 : blume 301
14 : blume 303 type env = GenericVC.Environment.dynenv
15 : blume 301
16 : blume 303 datatype ord_key =
17 :     SML of SmlInfo.info
18 :     | STABLE of BinInfo.info
19 : blume 301
20 : blume 303 fun compare (SML _, STABLE _) = LESS
21 :     | compare (STABLE _, SML _) = GREATER
22 :     | compare (SML i, SML i') = SmlInfo.compare (i, i')
23 :     | compare (STABLE i, STABLE i') = BinInfo.compare (i, i')
24 :    
25 :    
26 : blume 320 structure K = struct
27 :     type ord_key = ord_key
28 :     val compare = compare
29 :     end
30 : blume 303
31 : blume 320 structure Map = BinaryMapFn (K)
32 :    
33 :     structure Set = BinarySetFn (K)
34 :    
35 :     type persentry = env * Set.set ref
36 :     type tmpentry = env * ord_key list
37 :    
38 :     val persmap = ref (Map.empty: persentry option Map.map)
39 :     val tmpmap = ref (Map.empty: tmpentry Map.map)
40 :    
41 :     fun share (SML i) = SmlInfo.share i
42 :     | share (STABLE i) = BinInfo.share i
43 :    
44 :     fun discard (k, m) =
45 :     case Map.find (m, k) of
46 :     NONE => m
47 :     | SOME NONE => m
48 :     | SOME (SOME (_, ref dl)) =>
49 :     Set.foldl discard (Map.insert (m, k, NONE)) dl
50 :    
51 :     fun discard_pers i = persmap := discard (i, !persmap)
52 :    
53 : blume 295 local
54 :     structure RecompPersstate =
55 :     RecompPersstateFn (structure MachDepVC = MachDepVC
56 : blume 301 val discard_code = false
57 : blume 320 val discard_value = discard_pers o SML)
58 : blume 295 in
59 :     open RecompPersstate
60 : blume 301 end
61 : blume 295
62 : blume 320 infix o'
63 : blume 301 fun (f o' g) (x, y) = f (g x, y)
64 : blume 295
65 : blume 320 fun exec_look (k, gp) = let
66 : blume 354 fun descr (SML i) = SmlInfo.descr i
67 : blume 320 | descr (STABLE i) = BinInfo.describe i
68 : blume 303 fun error (SML i) = SmlInfo.error gp i
69 : blume 306 | error (STABLE i) = BinInfo.error i
70 : blume 303 in
71 :     case Map.find (!tmpmap, k) of
72 :     NONE =>
73 : blume 320 (case Map.find (!persmap, k) of
74 :     NONE => NONE
75 :     | SOME NONE =>
76 :     (if share k = SOME true then
77 :     error k EM.WARN
78 :     (concat ["re-instantiating ", descr k,
79 :     " (sharing may be lost)"])
80 :     EM.nullErrorBody
81 :     else ();
82 :     NONE)
83 :     | SOME (SOME (e, _)) =>
84 :     if share k = SOME false then
85 :     (discard_pers k; NONE)
86 :     else SOME e)
87 :     | SOME (e, _) => SOME e
88 : blume 303 end
89 : blume 295
90 : blume 320 val exec_look_sml = exec_look o' SML
91 :     val exec_look_stable = exec_look o' STABLE
92 : blume 302
93 : blume 320 fun exec_memo (k, e, d) = tmpmap := Map.insert (!tmpmap, k, (e, d))
94 : blume 295
95 : blume 320 fun exec_memo_sml (i, e, sl, bl) =
96 :     exec_memo (SML i, e, map STABLE bl @ map SML sl)
97 : blume 302
98 : blume 320 fun exec_memo_stable (i, e, il) =
99 :     exec_memo (STABLE i, e, map STABLE il)
100 :    
101 :     fun rememberShared gp = let
102 :     fun retainShared (k, (e, d), m) = let
103 :     val m = discard (k, m)
104 :     in
105 :     if share k = SOME false then m
106 :     else Map.insert (m, k, SOME (e, ref Set.empty))
107 :     end
108 :     fun addDep (k, (e, d)) = let
109 :     fun addOneDep k' =
110 :     case Map.find (!persmap, k') of
111 :     NONE => ()
112 :     | SOME NONE => ()
113 :     | SOME (SOME (_, r as ref s)) => r := Set.add (s, k)
114 :     in
115 :     app addOneDep d
116 :     end
117 :     val tm = !tmpmap
118 : blume 302 in
119 : blume 320 tmpmap := Map.empty;
120 :     persmap := Map.foldli retainShared (!persmap) tm;
121 :     Map.appi addDep tm
122 : blume 302 end
123 : blume 295 end

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