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
ViewVC logotype

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

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

revision 319, Mon Jun 7 22:47:00 1999 UTC revision 320, Tue Jun 8 07:42:11 1999 UTC
# Line 17  Line 17 
17      structure PP = PrettyPrint      structure PP = PrettyPrint
18      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
19    
20      type env = (unit -> E.dynenv) * bool      type env = (unit -> E.dynenv) * SmlInfo.info list * BinInfo.info list
21      type benv = env      type benv = env
22      type envdelta = env      type envdelta = env
23      type result = E.dynenv      type result = E.dynenv
24    
25      fun layer ((d, n), (d', n')) = (fn () => DE.atop (d (), d'()), n orelse n')      fun layer ((d, sl, bl), (d', sl', bl')) =
26            (fn () => DE.atop (d (), d' ()), sl @ sl', bl @ bl')
27    
28      fun filter (e, _) = e      fun filter (e, _) = e
29      fun nofilter e = e      fun nofilter e = e
# Line 32  Line 33 
33      val bnofilter = nofilter      val bnofilter = nofilter
34    
35      val empty = DE.empty      val empty = DE.empty
36      fun env2result ((mkEnv, flag): env) = mkEnv ()      fun env2result ((mkEnv, _, _): env) = mkEnv ()
37      fun rlayer (r, r') = DE.atop (r, r')      fun rlayer (r, r') = DE.atop (r, r')
38    
39      fun primitive (gp: GeneralParams.info) p =      fun primitive (gp: GeneralParams.info) p =
40          (fn () => E.dynamicPart (Primitive.env (#primconf (#param gp)) p),          (fn () => E.dynamicPart (Primitive.env (#primconf (#param gp)) p),
41           false)           [], [])
42    
43      fun pervasive (gp: GeneralParams.info) =      fun pervasive (gp: GeneralParams.info) =
44          (fn () => E.dynamicPart (#pervasive (#param gp)), false)          (fn () => E.dynamicPart (#pervasive (#param gp)),
45             [], [])
46    
47      val bpervasive = pervasive      val bpervasive = pervasive
48    
49      fun thunkify (d, n) = (fn () => d, n)      fun thunkify d () = d
50    
51      fun execute (bfc, (mkdyn, newCtxt), error, descr, memo) = let      fun execute (bfc, mkdyn, error, descr, memo, sl, bl) = let
52          val e = BF.exec (bfc, mkdyn ())          val e = BF.exec (bfc, mkdyn ())
53          val de = E.dynamicPart e          val de = E.dynamicPart e
54      in      in
55          memo de;          memo de;
56          SOME (thunkify (de, newCtxt))          SOME (thunkify de, sl, bl)
57      end handle exn => let      end handle exn => let
58          fun ppb pps =          fun ppb pps =
59              (PP.add_newline pps;              (PP.add_newline pps;
# Line 62  Line 64 
64          NONE          NONE
65      end      end
66    
67      fun dostable (i, mkenv, gp) =      fun dostable (i, mkbenv, gp) =
68          case mkenv () of          case mkbenv () of
69              NONE => NONE              NONE => NONE
70            | SOME (e as (dyn, newCtxt)) =>            | SOME (benv, sl, bl) =>
71                  (case PS.exec_look_stable (i, newCtxt, gp) of                  (case PS.exec_look_stable (i, gp) of
72                       SOME m => SOME (thunkify m)                       SOME m => SOME (thunkify m, [], [i])
73                     | NONE => execute (PS.bfc_fetch_stable i, e,                     | NONE => (execute (PS.bfc_fetch_stable i, benv,
74                                        BinInfo.error i EM.COMPLAIN,                                        BinInfo.error i EM.COMPLAIN,
75                                        BinInfo.describe i,                                        BinInfo.describe i,
76                                        fn e => PS.exec_memo_stable (i, e)))                                         fn e => PS.exec_memo_stable (i, e, bl),
77                                           [], [i])))
78    
79      fun dosml (i, e as (dyn, newCtxt), gp) =      fun fetch_sml i =
80          case PS.exec_look_sml (i, newCtxt, gp) of          PS.bfc_fetch_sml i handle e => (print "!!! fetch_sml\n"; raise e)
81              SOME m => SOME (thunkify m)  
82            | NONE => execute (PS.bfc_fetch_sml i, e,      fun dosml (i, (env, sl, bl), gp) =
83            case PS.exec_look_sml (i, gp) of
84                SOME m => SOME (thunkify m, [i], [])
85              | NONE => (execute (fetch_sml i, env,
86                               SmlInfo.error gp i EM.COMPLAIN,                               SmlInfo.error gp i EM.COMPLAIN,
87                               SmlInfo.name i,                               SmlInfo.name i,
88                               fn m => PS.exec_memo_sml (i, m))                                fn m => PS.exec_memo_sml (i, m, sl, bl),
89                                  [i], []))
90  end  end

Legend:
Removed from v.319  
changed lines
  Added in v.320

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