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/recomp.sml
[smlnj] / sml / trunk / src / cm / compile / recomp.sml  
ViewVC logotype

Diff of /sml/trunk/src/cm/compile/recomp.sml

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

revision 350, Wed Jun 23 00:38:58 1999 UTC revision 351, Wed Jun 23 06:44:27 1999 UTC
# Line 24  Line 24 
24      type statenv = E.staticEnv      type statenv = E.staticEnv
25      type symenv = E.symenv      type symenv = E.symenv
26    
27      type benv = statenv      type benv = unit -> statenv
28      type result = { stat: statenv, sym: symenv }      type result = { stat: statenv, sym: symenv }
29      type env = { envs: result, pids: PidSet.set }      type env = { envs: unit -> result, pids: PidSet.set }
30    
31      val empty = { stat = E.staticPart E.emptyEnv,      val empty = { stat = E.staticPart E.emptyEnv,
32                    sym = E.symbolicPart E.emptyEnv }                    sym = E.symbolicPart E.emptyEnv }
33    
34      fun env2result (e: env) = #envs e      fun env2result (e: env) = #envs e ()
35    
36      fun rlayer (r, r') = let      fun rlayer (r, r') = let
37          fun r2e { stat, sym } = E.mkenv { static = stat, symbolic = sym,          fun r2e { stat, sym } = E.mkenv { static = stat, symbolic = sym,
# Line 59  Line 59 
59      (* persistent state! *)      (* persistent state! *)
60      val filtermap = ref (FilterMap.empty: pid FilterMap.map)      val filtermap = ref (FilterMap.empty: pid FilterMap.map)
61    
62      fun blayer (be, be') = E.layerStatic (be, be')      fun blayer (be, be') = fn () => E.layerStatic (be (), be' ())
63    
64      fun layer ({ envs, pids }, { envs = e', pids = p' }) =      fun layer ({ envs = e, pids = p }, { envs = e', pids = p' }) =
65          { envs = rlayer (envs, e'), pids = PidSet.union (pids, p') }          { envs = fn () => rlayer (e (), e' ()),
66              pids = PidSet.union (p, p') }
67    
68      fun bfilter (d: envdelta, s) =      fun exportsNothingBut set se =
69          E.filterStaticEnv (#1 (#stat d), SymbolSet.listItems s)          List.all (fn sy => SymbolSet.member (set, sy)) (E.catalogEnv se)
70    
71        fun bfilter (d: envdelta, s) = let
72            val se = #1 (#stat d)
73        in
74            if exportsNothingBut s se then (fn () => se)
75            else (fn () => E.filterStaticEnv (se, SymbolSet.listItems s))
76        end
77    
78      fun pidset (p1, p2) =      fun pidset (p1, p2) =
79          PidSet.add (PidSet.singleton p1, p2)          PidSet.add (PidSet.singleton p1, p2)
80    
81      fun filter (d, s) = let      fun filter (d: envdelta, s) = let
82          val stat = bfilter (d, s)          val se = #1 (#stat d)
83          val (sym, sympid) = #sym d          val (sym, sympid) = #sym d
84          val statpid = #2 (#stat d)          val statpid = #2 (#stat d)
85        in
86            if exportsNothingBut s se then
87                { envs = fn () => { stat = se, sym = sym },
88                  pids = pidset (statpid, sympid) }
89            else let
90                val stat = E.filterStaticEnv (se, SymbolSet.listItems s)
91          val ctxt = #ctxt d          val ctxt = #ctxt d
92          val key = (statpid, s)          val key = (statpid, s)
93          val statpid' =          val statpid' =
# Line 82  Line 96 
96                | NONE => let                | NONE => let
97                      val statpid' = GenericVC.MakePid.makePid (ctxt, stat)                      val statpid' = GenericVC.MakePid.makePid (ctxt, stat)
98                  in                  in
99                      filtermap := FilterMap.insert (!filtermap, key, statpid');                          filtermap :=
100                                  FilterMap.insert (!filtermap, key, statpid');
101                      statpid'                      statpid'
102                  end                  end
103      in      in
104          { envs = { stat = stat, sym = sym }, pids = pidset (statpid', sympid) }              { envs = fn () => { stat = stat, sym = sym },
105                  pids = pidset (statpid', sympid) }
106            end
107      end      end
108    
109      fun bnofilter (d: envdelta) = #1 (#stat d)      fun bnofilter (d: envdelta) = (fn () => #1 (#stat d))
110    
111      fun nofilter (d: envdelta) = let      fun nofilter (d: envdelta) = let
112          val (stat, statpid) = #stat d          val (stat, statpid) = #stat d
113          val (sym, sympid) = #sym d          val (sym, sympid) = #sym d
114      in      in
115          { envs = { stat = stat, sym = sym }, pids = pidset (statpid, sympid) }          { envs = fn () => { stat = stat, sym = sym },
116              pids = pidset (statpid, sympid) }
117      end      end
118    
119      fun primitive (gp: GeneralParams.info) p = let      fun primitive (gp: GeneralParams.info) p = let
# Line 111  Line 129 
129      fun pervasive (gp: GeneralParams.info) = let      fun pervasive (gp: GeneralParams.info) = let
130          val e = #pervasive (#param gp)          val e = #pervasive (#param gp)
131      in      in
132          { envs = { stat = E.staticPart e, sym = E.symbolicPart e },          { envs = fn () => { stat = E.staticPart e, sym = E.symbolicPart e },
133            pids = PidSet.empty }            pids = PidSet.empty }
134      end      end
135    
136      fun bpervasive (gp: GeneralParams.info) =      fun bpervasive (gp: GeneralParams.info) =
137          E.staticPart (#pervasive (#param gp))          (fn () => E.staticPart (#pervasive (#param gp)))
138    
139      fun memo2envdelta { bfc, ctxt } =      fun memo2envdelta { bfc, ctxt } =
140          { stat = (BF.senvOf bfc, BF.staticPidOf bfc),          { stat = (BF.senvOf bfc, BF.staticPidOf bfc),
# Line 159  Line 177 
177            | NONE =>            | NONE =>
178                  (case mkenv () of                  (case mkenv () of
179                       NONE => NONE                       NONE => NONE
180                     | SOME be => load be)                     | SOME be => load (be ()))
181      end      end
182    
183      fun dosml (i, { envs = { stat, sym }, pids }, gp) = let      fun dosml (i, { envs, pids }, gp) = let
184          val pids = PidSet.union (pids, #pervcorepids (#param gp))          val pids = PidSet.union (pids, #pervcorepids (#param gp))
185      in      in
186          case Option.map memo2envdelta (PS.recomp_look_sml (i, pids, gp)) of          case Option.map memo2envdelta (PS.recomp_look_sml (i, pids, gp)) of
# Line 170  Line 188 
188            | NONE => let            | NONE => let
189                  val binpath = SmlInfo.binpath i                  val binpath = SmlInfo.binpath i
190                  val binname = AbsPath.name binpath                  val binname = AbsPath.name binpath
191                    val { stat, sym } = envs ()
192    
193                  fun save bfc = let                  fun save bfc = let
194                      fun writer s =                      fun writer s =
Legend:
Removed from v.350  
changed lines
  Added in v.351
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge