Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Tracker SCM

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/TopLevel/environ/environ.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/TopLevel/environ/environ.sml

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

revision 904, Mon Aug 20 19:50:05 2001 UTC revision 905, Thu Aug 23 21:53:02 2001 UTC
# Line 152  Line 152 
152  fun copystat([], senv) = senv  fun copystat([], senv) = senv
153    | copystat((s,b)::l, senv) = copystat(l,SE.bind(s, b, senv))    | copystat((s,b)::l, senv) = copystat(l,SE.bind(s, b, senv))
154    
155    (*
156  fun filterStaticEnv(static: staticEnv, symbols: S.symbol list) : staticEnv =  fun filterStaticEnv(static: staticEnv, symbols: S.symbol list) : staticEnv =
157        copystat(getbindings(static, symbols), SE.empty)        copystat(getbindings(static, symbols), SE.empty)
158    *)
159    
160  local  local
161      fun copydynsym (bindings, dynamic, symbolic) = let      fun copydynsym (bindings, dynamic, symbolic) = let
# Line 181  Line 183 
183          in {static =senv, dynamic = denv, symbolic = syenv}          in {static =senv, dynamic = denv, symbolic = syenv}
184          end          end
185    
     fun catalogEnv static : S.symbol list = map #1 (SE.sort static)  
   
186      fun trimEnv { static, dynamic, symbolic } = let      fun trimEnv { static, dynamic, symbolic } = let
187          val syms = catalogEnv static          val syms = BrowseStatEnv.catalog static
188          val (dynamic, symbolic) =          val (dynamic, symbolic) =
189              copydynsym (getbindings (static, syms), dynamic, symbolic)              copydynsym (getbindings (static, syms), dynamic, symbolic)
190      in      in
# Line 192  Line 192 
192      end      end
193  end  end
194    
 (* CM-style environment lookup *)  
 datatype cmEnv  
   = CM_NONE  
   | CM_ENV of {look : S.symbol -> cmEnv,  
                symbols : unit -> S.symbol list}  
   
 exception CmEnvOfModule  
   
 fun lookElems elements sym =  
       (case MU.getSpec(elements,sym)  
          of M.STRspec{sign,...} => sigenv sign  
           | M.FCTspec{sign,...} => fsgenv sign  
           | _ => CM_NONE)  
       handle MU.Unbound _ => CM_NONE  
   
 and sigenv (s as M.SIG {elements,...}) =  
       CM_ENV {look = lookElems elements,  
               symbols = (fn () => MU.getSigSymbols s)}  
   | sigenv _ = CM_NONE  
   
 (*  
  * The following is a hack to make the cmEnvOfModule function consistent  
  * with the changes made on ast during the elaboration of ast into absyn.  
  * Syntactic changes made on ast by the elaborator should be propagated  
  * to this function so that CM can do the correct job. I personally think  
  * that syntactic changes on curried functors and insertions of <resultStr>s  
  * should be done on Ast directly, before the elaboration --- this way, we  
  * don't have to write the following ugly sigenvSp function.  
  *  
  *)  
 and sigenvSp (M.SIG {elements=[(sym,M.STRspec{sign,...})],...}) =  
     if S.name sym = "<resultStr>" then sigenv sign  
     else bug "unexpected case <resultStr> in sigenvSp"  
   | sigenvSp (M.SIG {elements=[(sym,M.FCTspec{sign,...})],...}) =  
     if S.name sym = "<functor>" then fsgenv sign  
     else bug "unexpected case <functtor> in sigenvSp"  
   | sigenvSp _ = bug "unexpected case in signenvSp"  
   
 and fsgenv (M.FSIG{bodysig,...}) = sigenvSp bodysig  
   | fsgenv _ = CM_NONE  
   
 fun strenv(M.STR { sign, ... }) = sigenv sign  
   | strenv _ = CM_NONE  
   
 fun fctenv(M.FCT { sign, ... }) = fsgenv sign  
   | fctenv _ = CM_NONE  
   
 fun cmEnvOfModule env sym =  
     (case SE.look(env,sym)  
        of B.SIGbind b => sigenv b  
         | B.STRbind b => strenv b  
         | B.FSGbind b => fsgenv b  
         | B.FCTbind b => fctenv b  
         | _ => CM_NONE)  
     handle SE.Unbound => CM_NONE  
   
195  fun describe static (s: symbol) : unit =  fun describe static (s: symbol) : unit =
196        let open PrettyPrint        let open PrettyPrint
197         in with_pp (ErrorMsg.defaultConsumer())         in with_pp (ErrorMsg.defaultConsumer())

Legend:
Removed from v.904  
changed lines
  Added in v.905

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