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 308, Wed Jun 2 01:26:19 1999 UTC revision 309, Wed Jun 2 03:21:57 1999 UTC
# Line 23  Line 23 
23    
24      (* the domain of (lookup p) must always properly include (exports p) *)      (* the domain of (lookup p) must always properly include (exports p) *)
25      val exports : configuration -> primitive -> SymbolSet.set      val exports : configuration -> primitive -> SymbolSet.set
26      val lookup : configuration -> primitive -> Symbol.symbol -> DAEnv.value      val da_env : configuration -> primitive -> DAEnv.env
27      val env : configuration -> primitive -> GenericVC.Environment.environment      val env : configuration -> primitive -> GenericVC.Environment.environment
28      val pidInfo : configuration -> primitive      val pidInfo : configuration -> primitive
29          -> { statpid: GenericVC.PersStamps.persstamp,          -> { statpid: GenericVC.PersStamps.persstamp,
# Line 49  Line 49 
49          BASIS          BASIS
50    
51      type pinfo = { exports : SymbolSet.set,      type pinfo = { exports : SymbolSet.set,
52                     lookup : Symbol.symbol -> DE.value,                     da_env : DE.env,
53                     env : GenericVC.Environment.environment }                     env : GenericVC.Environment.environment }
54    
55      type configuration = primitive -> pinfo      type configuration = primitive -> pinfo
# Line 71  Line 71 
71      fun reqpriv BASIS = reqpriv_basis      fun reqpriv BASIS = reqpriv_basis
72    
73      fun exports (cfg: configuration) p = #exports (cfg p)      fun exports (cfg: configuration) p = #exports (cfg p)
74      fun lookup (cfg: configuration) p = #lookup (cfg p)      fun da_env (cfg: configuration) p = #da_env (cfg p)
75      fun env (cfg: configuration) p = #env (cfg p)      fun env (cfg: configuration) p = #env (cfg p)
76    
77      fun configuration { basis } = let      fun configuration { basis } = let
   
78          fun gen_pinfo e = let          fun gen_pinfo e = let
79              fun l2s l = let              val (da_env, mkExports) = Statenv2DAEnv.cvt (E.staticPart e)
                 fun addModule (sy, set) =  
                     case Symbol.nameSpace sy of  
                         (Symbol.STRspace | Symbol.SIGspace |  
                          Symbol.FCTspace | Symbol.FSIGspace) =>  
                         SymbolSet.add (set, sy)  
                        | _ => set  
             in  
                 foldl addModule SymbolSet.empty l  
             end  
   
             fun cvt_fctenv look = cvt_result o look  
   
             and cvt_result (BE.CM_ENV cme) =  
                 SOME (DE.FCTENV (cvt_fctenv (#look cme)))  
               | cvt_result BE.CM_NONE = NONE  
   
             val sb = BE.staticPart (GenericVC.CoerceEnv.e2b e)  
             val looker = cvt_fctenv (BE.cmEnvOfModule sb)  
80          in          in
81              { exports = l2s (BE.catalogEnv sb),              { exports = mkExports (), da_env = da_env, env = e }
               lookup = valOf o looker,  
               env = e }  
82          end          end
83    
84          val basis_pinfo = gen_pinfo basis          val basis_pinfo = gen_pinfo basis

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

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