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/depend/se2dae.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/depend/se2dae.sml

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

revision 310, Wed Jun 2 07:28:27 1999 UTC revision 355, Sat Jun 26 13:17:30 1999 UTC
# Line 6  Line 6 
6   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7   *)   *)
8  signature STATENV2DAENV = sig  signature STATENV2DAENV = sig
9      val cvt :      val cvt : GenericVC.BareEnvironment.staticEnv ->
10          GenericVC.Environment.staticEnv -> DAEnv.env * (unit -> SymbolSet.set)          DAEnv.env * (unit -> SymbolSet.set)
11    
12      (* The thunk passed to cvtMemo will not be called until the first      (* The thunk passed to cvtMemo will not be called until the first
13       * attempt to query the resulting DAEnv.env.       * attempt to query the resulting DAEnv.env.
# Line 16  Line 16 
16       * to avoid queries that are known in advance to be unsuccessful       * to avoid queries that are known in advance to be unsuccessful
17       * because they would needlessly cause the thunk to be called. *)       * because they would needlessly cause the thunk to be called. *)
18      val cvtMemo :      val cvtMemo :
19          (unit -> GenericVC.Environment.staticEnv) ->          (unit -> GenericVC.BareEnvironment.staticEnv) ->
20          DAEnv.env          DAEnv.env
21  end  end
22    
# Line 29  Line 29 
29      and cvt_result (BE.CM_ENV { look, ... }) = SOME (cvt_fctenv look)      and cvt_result (BE.CM_ENV { look, ... }) = SOME (cvt_fctenv look)
30        | cvt_result BE.CM_NONE = NONE        | cvt_result BE.CM_NONE = NONE
31    
32      fun cvt se = let      fun cvt sb = let
33          fun l2s l = let          fun l2s l = let
34              fun addModule (sy, set) =              fun addModule (sy, set) =
35                  case Symbol.nameSpace sy of                  case Symbol.nameSpace sy of
# Line 40  Line 40 
40          in          in
41              foldl addModule SymbolSet.empty l              foldl addModule SymbolSet.empty l
42          end          end
         val sb = GenericVC.CoerceEnv.es2bs se  
43          val dae = cvt_fctenv (BE.cmEnvOfModule sb)          val dae = cvt_fctenv (BE.cmEnvOfModule sb)
44          fun mkDomain () = l2s (BE.catalogEnv sb)          fun mkDomain () = l2s (BE.catalogEnv sb)
45      in      in
46          (dae, mkDomain)          (dae, mkDomain)
47      end      end
48    
49      fun cvtMemo getSE = let      fun cvtMemo getSB = let
50          val l = ref (fn s => raise Fail "se2dae: uninitialized")          val l = ref (fn s => raise Fail "se2dae: uninitialized")
51          fun looker s = let          fun looker s = let
52              fun getCME () =              fun getCME () = BE.cmEnvOfModule (getSB ())
                 BE.cmEnvOfModule (GenericVC.CoerceEnv.es2bs (getSE ()))  
53              val lk = cvt_result o (getCME ())              val lk = cvt_result o (getCME ())
54          in          in
55              l := lk;              l := lk;

Legend:
Removed from v.310  
changed lines
  Added in v.355

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