[project @ 2001-03-08 12:07:38 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / RnEnv.lhs

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 582f0aa..c8090f9 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -21,29 +21,32 @@ import HsTypes              ( hsTyVarName, replaceTyVarName )
 import HscTypes                ( Provenance(..), pprNameProvenance, hasBetterProv,
                          ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv,
                          AvailInfo, Avails, GenAvailInfo(..), NameSupply(..), 
-                         Deprecations(..), lookupDeprec
+                         Deprecations(..), lookupDeprec,
+                         extendLocalRdrEnv
                        )
 import RnMonad
 import Name            ( Name,
                          getSrcLoc, 
                          mkLocalName, mkGlobalName,
                          mkIPName, nameOccName, nameModule_maybe,
-                         setNameModuleAndLoc, mkNameEnv
+                         setNameModuleAndLoc
                        )
-import Name            ( extendNameEnv_C, plusNameEnv_C, nameEnvElts )
+import NameEnv
 import NameSet
 import OccName         ( OccName, occNameUserString, occNameFlavour )
 import Module          ( ModuleName, moduleName, mkVanillaModule, 
                          mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
-import TysWiredIn      ( unitTyCon, intTyCon, boolTyCon )
-import Type            ( funTyCon )
 import PrelNames       ( mkUnboundName, syntaxList, SyntaxMap, vanillaSyntaxMap,
                          derivingOccurrences,
                          mAIN_Name, pREL_MAIN_Name, 
-                         ioTyConName, printName,
+                         ioTyConName, integerTyConName, doubleTyConName, intTyConName, 
+                         boolTyConName, funTyConName,
                          unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
-                         eqStringName
+                         eqStringName, printName, 
+                         hasKey, fractionalClassKey, numClassKey,
+                         bindIOName, returnIOName, failIOName
                        )
+import TysWiredIn      ( unitTyCon )   -- A little odd
 import FiniteMap
 import UniqSupply
 import SrcLoc          ( SrcLoc, noSrcLoc )
@@ -375,8 +378,10 @@ addImplicitFVs gbl_env maybe_mod source_fvs
     returnRn (slurp_fvs, sugar_map)
 
   where
-    extra_implicits Nothing            -- Compiling an expression
-      = returnRn (unitFV printName)    -- print :: a -> IO () may be needed later
+    extra_implicits Nothing            -- Compiling a statement
+      = returnRn (mkFVs [printName, bindIOName, returnIOName, failIOName])
+               -- These are all needed implicitly when compiling a statement
+               -- See TcModule.tc_stmts
 
     extra_implicits (Just (mod_name, decls))   -- Compiling a module
       = lookupOrigNames deriv_occs             `thenRn` \ deriving_names ->
@@ -399,15 +404,25 @@ ubiquitousNames
        -- Virtually every program has error messages in it somewhere
 
   `plusFV`
-    mkFVs (map getName [unitTyCon, funTyCon, boolTyCon, intTyCon])
-       -- Add occurrences for Int, and (), because they
-       -- are the types to which ambigious type variables may be defaulted by
-       -- the type checker; so they won't always appear explicitly.
-       -- [The () one is a GHC extension for defaulting CCall results.]
-       -- ALSO: funTyCon, since it occurs implicitly everywhere!
-       --       (we don't want to be bothered with making funTyCon a
+    mkFVs [getName unitTyCon, funTyConName, boolTyConName, intTyConName]
+       -- Add occurrences for very frequently used types.
+       --       (e.g. we don't want to be bothered with making funTyCon a
        --        free var at every function application!)
-       -- Double is dealt with separately in getGates
+\end{code}
+
+\begin{code}
+implicitGates :: Name -> FreeVars      
+-- If we load class Num, add Integer to the gates
+-- This takes account of the fact that Integer might be needed for
+-- defaulting, but we don't want to load Integer (and all its baggage)
+-- if there's no numeric stuff needed.
+-- Similarly for class Fractional and Double
+--
+-- NB: If we load (say) Floating, we'll end up loading Fractional too,
+--     since Fractional is a superclass of Floating
+implicitGates cls | cls `hasKey` numClassKey       = unitFV integerTyConName
+                 | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
+                 | otherwise                       = emptyFVs
 \end{code}
 
 \begin{code}
@@ -529,10 +544,8 @@ bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b   $ \ name' ->
 
 bindLocalNames names enclosed_scope
   = getLocalNameEnv            `thenRn` \ name_env ->
-    setLocalNameEnv (addListToRdrEnv name_env pairs)
+    setLocalNameEnv (extendLocalRdrEnv name_env names)
                    enclosed_scope
-  where
-    pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
 
 bindLocalNamesFV names enclosed_scope
   = bindLocalNames names $
@@ -749,6 +762,8 @@ in error messages.
 
 \begin{code}
 unQualInScope :: GlobalRdrEnv -> Name -> Bool
+-- True if 'f' is in scope, and has only one binding
+-- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
 unQualInScope env
   = (`elemNameSet` unqual_names)
   where