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/semant/primitive.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/semant/primitive.sml

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

revision 286, Fri May 21 07:47:16 1999 UTC revision 294, Tue May 25 09:06:06 1999 UTC
# Line 19  Line 19 
19      (* the domain of (lookup p) must always properly include (exports p) *)      (* the domain of (lookup p) must always properly include (exports p) *)
20      val exports : configuration -> primitive -> SymbolSet.set      val exports : configuration -> primitive -> SymbolSet.set
21      val lookup : configuration -> primitive -> Symbol.symbol -> DAEnv.value      val lookup : configuration -> primitive -> Symbol.symbol -> DAEnv.value
22        val static : configuration -> primitive -> GenericVC.Environment.staticEnv
23        val symbolic : configuration -> primitive -> GenericVC.Environment.symenv
24    
25      val configuration :      val configuration :
26          { basis: GenericVC.Environment.environment }          { basis: GenericVC.Environment.environment }
# Line 28  Line 30 
30  structure Primitive :> PRIMITIVE = struct  structure Primitive :> PRIMITIVE = struct
31    
32      structure BE = GenericVC.BareEnvironment      structure BE = GenericVC.BareEnvironment
33        structure E = GenericVC.Environment
34      structure DE = DAEnv      structure DE = DAEnv
35    
36      (* For now, we only know about the "basis".      (* For now, we only know about the "basis".
# Line 38  Line 41 
41          BASIS          BASIS
42    
43      type pinfo = { exports : SymbolSet.set,      type pinfo = { exports : SymbolSet.set,
44                     lookup : Symbol.symbol -> DE.value }                     lookup : Symbol.symbol -> DE.value,
45                       static : GenericVC.Environment.staticEnv,
46                       symbolic : GenericVC.Environment.symenv }
47    
48      type configuration = primitive -> pinfo      type configuration = primitive -> pinfo
49    
# Line 51  Line 56 
56    
57      fun exports (cfg: configuration) p = #exports (cfg p)      fun exports (cfg: configuration) p = #exports (cfg p)
58      fun lookup (cfg: configuration) p = #lookup (cfg p)      fun lookup (cfg: configuration) p = #lookup (cfg p)
59        fun static (cfg: configuration) p = #static (cfg p)
60        fun symbolic (cfg: configuration) p = #symbolic (cfg p)
61    
62      fun configuration { basis } = let      fun configuration { basis } = let
63    
64            fun gen_pinfo e = let
65          fun l2s l = let          fun l2s l = let
66              fun addModule (sy, set) =              fun addModule (sy, set) =
67                  case Symbol.nameSpace sy of                  case Symbol.nameSpace sy of
# Line 70  Line 79 
79          and cvt_result (BE.CM_ENV cme) = SOME (DE.FCTENV (cvt_fctenv cme))          and cvt_result (BE.CM_ENV cme) = SOME (DE.FCTENV (cvt_fctenv cme))
80            | cvt_result BE.CM_NONE = NONE            | cvt_result BE.CM_NONE = NONE
81    
82          val sb = BE.staticPart (GenericVC.CoerceEnv.e2b basis)              val sb = BE.staticPart (GenericVC.CoerceEnv.e2b e)
83                val static = E.staticPart e
84                val symbolic = E.symbolicPart e
85    
86          val { domain, looker } =          val { domain, looker } =
87              cvt_fctenv { symbols = fn () => BE.catalogEnv sb,              cvt_fctenv { symbols = fn () => BE.catalogEnv sb,
88                           look = BE.cmEnvOfModule sb }                           look = BE.cmEnvOfModule sb }
89          val pinfo = { exports = domain (), lookup = valOf o looker }          in
90                { exports = domain (), lookup = valOf o looker,
91                  static = static, symbolic = symbolic }
92            end
93    
94          fun cfg BASIS = pinfo          val basis_pinfo = gen_pinfo basis
95            fun cfg BASIS = basis_pinfo
96      in      in
97          cfg          cfg
98      end      end

Legend:
Removed from v.286  
changed lines
  Added in v.294

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