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 309, Wed Jun 2 03:21:57 1999 UTC revision 310, Wed Jun 2 07:28:27 1999 UTC
# Line 8  Line 8 
8  signature STATENV2DAENV = sig  signature STATENV2DAENV = sig
9      val cvt :      val cvt :
10          GenericVC.Environment.staticEnv -> DAEnv.env * (unit -> SymbolSet.set)          GenericVC.Environment.staticEnv -> DAEnv.env * (unit -> SymbolSet.set)
11    
12        (* The thunk passed to cvtMemo will not be called until the first
13         * attempt to query the resulting DAEnv.env.
14         * If the symbols for which queries succeed are known, then one
15         * should further guard the resulting env with an appropriate filter
16         * to avoid queries that are known in advance to be unsuccessful
17         * because they would needlessly cause the thunk to be called. *)
18        val cvtMemo :
19            (unit -> GenericVC.Environment.staticEnv) ->
20            DAEnv.env
21  end  end
22    
23  structure Statenv2DAEnv :> STATENV2DAENV = struct  structure Statenv2DAEnv :> STATENV2DAENV = struct
24    
25      structure BE = GenericVC.BareEnvironment      structure BE = GenericVC.BareEnvironment
26    
27        fun cvt_fctenv look = DAEnv.FCTENV (cvt_result o look)
28    
29        and cvt_result (BE.CM_ENV { look, ... }) = SOME (cvt_fctenv look)
30          | cvt_result BE.CM_NONE = NONE
31    
32      fun cvt se = let      fun cvt se = let
33          fun l2s l = let          fun l2s l = let
34              fun addModule (sy, set) =              fun addModule (sy, set) =
# Line 25  Line 40 
40          in          in
41              foldl addModule SymbolSet.empty l              foldl addModule SymbolSet.empty l
42          end          end
         fun cvt_fctenv look = DAEnv.FCTENV (cvt_result o look)  
         and cvt_result (BE.CM_ENV { look, ... }) = SOME (cvt_fctenv look)  
           | cvt_result BE.CM_NONE = NONE  
43          val sb = GenericVC.CoerceEnv.es2bs se          val sb = GenericVC.CoerceEnv.es2bs se
44          val dae = cvt_fctenv (BE.cmEnvOfModule sb)          val dae = cvt_fctenv (BE.cmEnvOfModule sb)
45          fun mkDomain () = l2s (BE.catalogEnv sb)          fun mkDomain () = l2s (BE.catalogEnv sb)
46      in      in
47          (dae, mkDomain)          (dae, mkDomain)
48      end      end
49    
50        fun cvtMemo getSE = let
51            val l = ref (fn s => raise Fail "se2dae: uninitialized")
52            fun looker s = let
53                fun getCME () =
54                    BE.cmEnvOfModule (GenericVC.CoerceEnv.es2bs (getSE ()))
55                val lk = cvt_result o (getCME ())
56            in
57                l := lk;
58                lk s
59            end
60        in
61            l := looker;
62            DAEnv.FCTENV (fn s => !l s)
63        end
64  end  end

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

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