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

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

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

revision 297, Thu May 27 08:29:19 1999 UTC revision 298, Thu May 27 09:42:28 1999 UTC
# Line 22  Line 22 
22      type benv = env      type benv = env
23      type envdelta = env      type envdelta = env
24    
     datatype lookstable_result =  
         FOUND of envdelta  
       | NOTFOUND of benv option  
   
25      fun layer ({ dyn = d, dts = s }, { dyn = d', dts = s' }) =      fun layer ({ dyn = d, dts = s }, { dyn = d', dts = s' }) =
26          { dyn = fn () => DE.atop (d (), d' ()), dts = DTS.join (s, s') }          { dyn = fn () => DE.atop (d (), d' ()), dts = DTS.join (s, s') }
27    
# Line 42  Line 38 
38    
39      fun thunkify { dyn, dts } = { dyn = fn () => dyn, dts = dts }      fun thunkify { dyn, dts } = { dyn = fn () => dyn, dts = dts }
40    
     fun lookstable (i, mkenv, gp) =  
         case mkenv () of  
             NONE => NOTFOUND NONE  
           | SOME (e as { dyn, dts }) =>  
                 (case PS.exec_look_stable (i, dts, gp) of  
                      SOME memo => FOUND (thunkify memo)  
                    | NONE => NOTFOUND (SOME e))  
   
41      fun execute (bfc, { dyn = mkdyn, dts }, share, error, descr, memo) = let      fun execute (bfc, { dyn = mkdyn, dts }, share, error, descr, memo) = let
42          val (tryshare, mustshare) =          val (tryshare, mustshare) =
43              case share of              case share of
# Line 91  Line 79 
79          else doit ()          else doit ()
80      end      end
81    
82      fun dostable (i, e, gp) =      fun dostable (i, mkenv, gp) =
83          execute (PS.bfc_fetch_stable i, e,          case mkenv () of
84                NONE => NONE
85              | SOME (e as { dyn, dts }) =>
86                    (case PS.exec_look_stable (i, dts, gp) of
87                         SOME memo => SOME (thunkify memo)
88                       | NONE => execute (PS.bfc_fetch_stable i, e,
89                   BinInfo.share i,                   BinInfo.share i,
90                   BinInfo.error gp i EM.COMPLAIN,                   BinInfo.error gp i EM.COMPLAIN,
91                   BinInfo.describe i,                   BinInfo.describe i,
92                   fn m => PS.exec_memo_stable (i, m))                                        fn m => PS.exec_memo_stable (i, m)))
93    
94      fun looksml (i, { dyn, dts }, gp) =      fun dosml (i, e as { dyn, dts }, gp) = let
95            fun looksml () =
96          Option.map thunkify (PS.exec_look_sml (i, dts, gp))          Option.map thunkify (PS.exec_look_sml (i, dts, gp))
97        in
98      fun dosml (i, e, gp) =          case looksml () of
99          execute (PS.bfc_fetch_sml i, e,              SOME d => SOME d
100              | NONE => execute (PS.bfc_fetch_sml i, e,
101                   SmlInfo.share i,                   SmlInfo.share i,
102                   SmlInfo.error gp i EM.COMPLAIN,                   SmlInfo.error gp i EM.COMPLAIN,
103                   SmlInfo.name i,                   SmlInfo.name i,
104                   fn m => PS.exec_memo_sml (i, m))                   fn m => PS.exec_memo_sml (i, m))
105  end  end
106    end
Legend:
Removed from v.297  
changed lines
  Added in v.298
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge