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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 302, Sat May 29 03:19:59 1999 UTC revision 303, Sun May 30 10:23:20 1999 UTC
# Line 8  Line 8 
8  functor FullPersstateFn (structure MachDepVC : MACHDEP_VC) :> FULL_PERSSTATE =  functor FullPersstateFn (structure MachDepVC : MACHDEP_VC) :> FULL_PERSSTATE =
9      struct      struct
10          structure E = GenericVC.Environment          structure E = GenericVC.Environment
         structure DTS = DynTStamp  
11    
12          type exec_memo = { dyn: E.dynenv, dts: DTS.dts }          type env = GenericVC.Environment.dynenv
13    
14          val smlmap = ref (AbsPathMap.empty: exec_memo AbsPathMap.map)          datatype ord_key =
15          val stablemap = ref (StableMap.empty: exec_memo StableMap.map)              SML of SmlInfo.info
16              | STABLE of BinInfo.info
17    
18            fun compare (SML _, STABLE _) = LESS
19              | compare (STABLE _, SML _) = GREATER
20              | compare (SML i, SML i') = SmlInfo.compare (i, i')
21              | compare (STABLE i, STABLE i') = BinInfo.compare (i, i')
22    
23            structure Map =
24                BinaryMapFn (struct
25                    type ord_key = ord_key
26                    val compare = compare
27                end)
28    
29            val persmap = ref (Map.empty: env Map.map)
30            val tmpmap = ref (Map.empty: env Map.map)
31    
32          local          local
33              fun discard_value i = let              fun discard_value i =
34                  val p = SmlInfo.sourcepath i                  persmap := (#1 (Map.remove (!persmap, SML i)))
35                  val m = !smlmap                  handle LibBase.NotFound => ()
36                  val m' =  
                     #1 (AbsPathMap.remove (m, p))  
                     handle LibBase.NotFound => m  
             in  
                 smlmap := m'  
             end  
37              structure RecompPersstate =              structure RecompPersstate =
38                  RecompPersstateFn (structure MachDepVC = MachDepVC                  RecompPersstateFn (structure MachDepVC = MachDepVC
39                                     val discard_code = false                                     val discard_code = false
# Line 37  Line 46 
46          fun (f o' g) (x, y) = f (g x, y)          fun (f o' g) (x, y) = f (g x, y)
47          fun (f o'' g) (x, y, z) = f (g x, y, z)          fun (f o'' g) (x, y, z) = f (g x, y, z)
48    
         datatype key =  
             SML of SmlInfo.info  
           | STABLE of BinInfo.info  
   
         fun find (SML i) = AbsPathMap.find (!smlmap, SmlInfo.sourcepath i)  
           | find (STABLE i) = StableMap.find (!stablemap, i)  
   
         fun insert (SML i, m) =  
             smlmap := AbsPathMap.insert (!smlmap, SmlInfo.sourcepath i, m)  
           | insert (STABLE i, m) =  
             stablemap := StableMap.insert (!stablemap, i, m)  
   
         fun remove (SML i) =  
             smlmap := #1 (AbsPathMap.remove (!smlmap, SmlInfo.sourcepath i))  
           | remove (STABLE i) =  
             stablemap := #1 (StableMap.remove (!stablemap, i))  
   
49          fun share (SML i) = SmlInfo.share i          fun share (SML i) = SmlInfo.share i
50            | share (STABLE i) = BinInfo.share i            | share (STABLE i) = BinInfo.share i
51    
52          fun error gp (SML i) = SmlInfo.error gp i          fun exec_look (k, newCtxt, gp) = let
53            | error gp (STABLE i) = BinInfo.error gp i              fun error (SML i) = SmlInfo.error gp i
54                  | error (STABLE i) = BinInfo.error gp i
55          fun descr (SML i) = SmlInfo.name i          fun descr (SML i) = SmlInfo.name i
56            | descr (STABLE i) = BinInfo.describe i            | descr (STABLE i) = BinInfo.describe i
57                fun didExist () = isSome (Map.find (!persmap, k))
58          fun exec_look (i, s, gp) =              fun warn_reinst () =
59              case find i of                  if share k = SOME true andalso didExist () then
60                  NONE => NONE                      error k GenericVC.ErrorMsg.WARN
61                | SOME (memo as { dts = s', ... }) => let                              (concat ["re-instantiating ", descr k,
                     fun warn () =  
                         error gp i GenericVC.ErrorMsg.WARN  
                               (concat ["reinstantiating ", descr i,  
62                                         " (sharing may be lost)"])                                         " (sharing may be lost)"])
63                                GenericVC.ErrorMsg.nullErrorBody                                GenericVC.ErrorMsg.nullErrorBody
64                    else ()
65                  in                  in
66                      if DTS.outdated { context = s, oldresult = s' } then              case Map.find (!tmpmap, k) of
67                          (if share i = SOME true then warn () else ();                  NONE =>
68                           (remove i; NONE))                      if newCtxt then (warn_reinst (); NONE)
69                      else SOME memo                      else (case Map.find (!persmap, k) of
70                                  NONE => NONE
71                                | SOME e =>
72                                      if share k = SOME false then
73                                         (persmap := #1 (Map.remove (!persmap, k));
74                                          NONE)
75                                      else  SOME (e, false))
76                  | SOME e => SOME (e, true)
77                  end                  end
78    
         fun exec_memo (i, memo) = insert (i, memo)  
   
79          val exec_look_sml = exec_look o'' SML          val exec_look_sml = exec_look o'' SML
80          val exec_look_stable = exec_look o'' STABLE          val exec_look_stable = exec_look o'' STABLE
81    
82            fun exec_memo (k, e) = tmpmap := Map.insert (!tmpmap, k, e)
83    
84          val exec_memo_sml = exec_memo o' SML          val exec_memo_sml = exec_memo o' SML
85          val exec_memo_stable = exec_memo o' STABLE          val exec_memo_stable = exec_memo o' STABLE
86    
87          fun forgetNonShared () = let          fun rememberShared () = let
88              fun isShareable { dyn, dts } =              fun retainShared (k, e, m) =
89                  not (isSome (DynTStamp.can'tShare dts))                  if share k = SOME false then m else Map.insert (m, k, e)
90          in          in
91              smlmap := AbsPathMap.filter isShareable (!smlmap);              persmap := Map.foldli retainShared (!persmap) (!tmpmap);
92              stablemap := StableMap.filter isShareable (!stablemap)              tmpmap := Map.empty
93          end          end
94      end      end

Legend:
Removed from v.302  
changed lines
  Added in v.303

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