[project @ 2005-02-16 10:50:23 by simonmar]
[ghc-hetmet.git] / ghc / compiler / rename / RnEnv.lhs
index 9b0374d..09bb3bc 100644 (file)
@@ -18,7 +18,7 @@ module RnEnv (
        newLocalsRn, newIPNameRn,
        bindLocalNames, bindLocalNamesFV,
        bindLocatedLocalsFV, bindLocatedLocalsRn,
-       bindPatSigTyVars, bindPatSigTyVarsFV,
+       bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
        bindTyVarsRn, extendTyVarEnvFVRn,
        bindLocalFixities,
 
@@ -30,11 +30,13 @@ module RnEnv (
 
 #include "HsVersions.h"
 
-import LoadIface       ( loadSrcInterface )
+import LoadIface       ( loadHomeInterface, loadSrcInterface )
 import IfaceEnv                ( lookupOrig, newGlobalBinder, newIPName )
-import HsSyn
+import HsSyn           ( FixitySig(..), ReboundNames, HsExpr(..), 
+                         HsType(..), HsExplicitForAll(..), LHsTyVarBndr, LHsType, 
+                         LSig, Sig(..), Fixity, hsLTyVarName, hsLTyVarLocNames, replaceTyVarName )
 import RdrHsSyn                ( extractHsTyRdrTyVars )
-import RdrName         ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
+import RdrName         ( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
                          mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
                          pprGlobalRdrEnv, lookupGRE_RdrName, 
                          isExact_maybe, isSrcRdrName,
@@ -42,10 +44,9 @@ import RdrName               ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
                          isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
                          Provenance(..), pprNameProvenance, ImportSpec(..) 
                        )
-import HsTypes         ( replaceTyVarName )
 import HscTypes                ( availNames, ModIface(..), FixItem(..), lookupFixity )
 import TcRnMonad
-import Name            ( Name, nameIsLocalOrFrom, mkInternalName, isInternalName,
+import Name            ( Name, nameIsLocalOrFrom, mkInternalName, 
                          nameSrcLoc, nameOccName, nameModule, nameParent, isExternalName )
 import NameSet
 import OccName         ( tcName, isDataOcc, occNameFlavour, reportIfUnused )
@@ -60,7 +61,6 @@ import Util           ( sortLe )
 import ListSetOps      ( removeDups )
 import List            ( nubBy )
 import CmdLineOpts
-import FastString      ( FastString )
 \end{code}
 
 %*********************************************************
@@ -338,6 +338,8 @@ lookupQualifiedName rdr_name
        mod = rdrNameModule rdr_name
        occ = rdrNameOcc rdr_name
    in
+   -- Note: we want to behave as we would for a source file import here,
+   -- and respect hiddenness of modules/packages, hence loadSrcInterface.
    loadSrcInterface doc mod False      `thenM` \ iface ->
 
    case  [ (mod,occ) | 
@@ -423,11 +425,13 @@ lookupFixityRn name
       -- nothing from B will be used).  When we come across a use of
       -- 'f', we need to know its fixity, and it's then, and only
       -- then, that we load B.hi.  That is what's happening here.
-        loadSrcInterface doc name_mod False    `thenM` \ iface ->
+      --
+      -- loadHomeInterface will find B.hi even if B is a hidden module,
+      -- and that's what we want.
+        initIfaceTcRn (loadHomeInterface doc name)     `thenM` \ iface ->
        returnM (mi_fix_fn iface (nameOccName name))
   where
     doc      = ptext SLIT("Checking fixity for") <+> ppr name
-    name_mod = nameModule name
 
 dataTcOccs :: RdrName -> [RdrName]
 -- If the input is a data constructor, return both it and a type
@@ -557,15 +561,16 @@ bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
                   (enclosed_scope names)
 
 
+bindLocalNames :: [Name] -> RnM a -> RnM a
 bindLocalNames names enclosed_scope
   = getLocalRdrEnv             `thenM` \ name_env ->
     setLocalRdrEnv (extendLocalRdrEnv name_env names)
                    enclosed_scope
 
+bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
 bindLocalNamesFV names enclosed_scope
-  = bindLocalNames names $
-    enclosed_scope `thenM` \ (thing, fvs) ->
-    returnM (thing, delListFromNameSet fvs names)
+  = do { (result, fvs) <- bindLocalNames names enclosed_scope
+       ; returnM (result, delListFromNameSet fvs names) }
 
 
 -------------------------------------
@@ -579,15 +584,10 @@ bindLocatedLocalsFV doc rdr_names enclosed_scope
     returnM (thing, delListFromNameSet fvs names)
 
 -------------------------------------
-extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
-       -- This tiresome function is used only in rnSourceDecl on InstDecl
-extendTyVarEnvFVRn tyvars enclosed_scope
-  = bindLocalNames tyvars enclosed_scope       `thenM` \ (thing, fvs) -> 
-    returnM (thing, delListFromNameSet fvs tyvars)
-
 bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
              -> ([LHsTyVarBndr Name] -> RnM a)
              -> RnM a
+-- Haskell-98 binding of type variables; e.g. within a data type decl
 bindTyVarsRn doc_str tyvar_names enclosed_scope
   = let
        located_tyvars = hsLTyVarLocNames tyvar_names
@@ -601,19 +601,22 @@ bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
   -- Find the type variables in the pattern type 
   -- signatures that must be brought into scope
 bindPatSigTyVars tys thing_inside
-  = getLocalRdrEnv             `thenM` \ name_env ->
-    let
-       located_tyvars  = nubBy eqLocated [ tv | ty <- tys,
-                                   tv <- extractHsTyRdrTyVars ty,
-                                   not (unLoc tv `elemLocalRdrEnv` name_env)
-                        ]
+  = do         { scoped_tyvars <- doptM Opt_ScopedTypeVariables
+       ; if not scoped_tyvars then 
+               thing_inside []
+         else 
+    do         { name_env <- getLocalRdrEnv
+       ; let locd_tvs  = [ tv | ty <- tys
+                              , tv <- extractHsTyRdrTyVars ty
+                              , not (unLoc tv `elemLocalRdrEnv` name_env) ]
+             nubbed_tvs = nubBy eqLocated locd_tvs
                -- The 'nub' is important.  For example:
                --      f (x :: t) (y :: t) = ....
                -- We don't want to complain about binding t twice!
 
-       doc_sig        = text "In a pattern type-signature"
-    in
-    bindLocatedLocalsRn doc_sig located_tyvars thing_inside
+       ; bindLocatedLocalsRn doc_sig nubbed_tvs thing_inside }}
+  where
+    doc_sig = text "In a pattern type-signature"
 
 bindPatSigTyVarsFV :: [LHsType RdrName]
                   -> RnM (a, FreeVars)
@@ -623,6 +626,37 @@ bindPatSigTyVarsFV tys thing_inside
     thing_inside               `thenM` \ (result,fvs) ->
     returnM (result, fvs `delListFromNameSet` tvs)
 
+bindSigTyVarsFV :: [LSig Name]
+               -> RnM (a, FreeVars)
+               -> RnM (a, FreeVars)
+-- Bind the top-level forall'd type variables in the sigs.
+-- E.g         f :: a -> a
+--     f = rhs
+--     The 'a' scopes over the rhs
+--
+-- NB: there'll usually be just one (for a function binding)
+--     but if there are many, one may shadow the rest; too bad!
+--     e.g  x :: [a] -> [a]
+--          y :: [(a,a)] -> a
+--          (x,y) = e
+--      In e, 'a' will be in scope, and it'll be the one from 'y'!
+bindSigTyVarsFV sigs thing_inside
+  = do { scoped_tyvars <- doptM Opt_ScopedTypeVariables
+       ; if not scoped_tyvars then 
+               thing_inside 
+         else
+               bindLocalNamesFV tvs thing_inside }
+  where
+    tvs = [ hsLTyVarName ltv 
+         | L _ (Sig _ (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs, ltv <- ltvs ]
+       -- Note the pattern-match on "Explicit"; we only bind
+       -- type variables from signatures with an explicit top-level for-all
+                               
+
+extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
+       -- This function is used only in rnSourceDecl on InstDecl
+extendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside
+
 -------------------------------------
 checkDupNames :: SDoc
              -> [Located RdrName]