newLocalsRn, newIPNameRn,
bindLocalNames, bindLocalNamesFV,
bindLocatedLocalsFV, bindLocatedLocalsRn,
- bindPatSigTyVars, bindPatSigTyVarsFV,
+ bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn,
bindLocalFixities,
#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,
isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
Provenance(..), pprNameProvenance, ImportSpec(..)
)
-import HsTypes ( replaceTyVarName )
import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity )
import TcRnMonad
-import Name ( Name, nameIsLocalOrFrom, mkInternalName, isInternalName,
- nameSrcLoc, nameOccName, nameModule, nameParent )
+import Name ( Name, nameIsLocalOrFrom, mkInternalName,
+ nameSrcLoc, nameOccName, nameModule, nameParent, isExternalName )
import NameSet
import OccName ( tcName, isDataOcc, occNameFlavour, reportIfUnused )
import Module ( Module )
import ListSetOps ( removeDups )
import List ( nubBy )
import CmdLineOpts
-import FastString ( FastString )
\end{code}
%*********************************************************
newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
newTopSrcBinder this_mod mb_parent (L loc rdr_name)
| Just name <- isExact_maybe rdr_name
- -- This is here to catch
+ = -- This is here to catch
-- (a) Exact-name binders created by Template Haskell
-- (b) The PrelBase defn of (say) [] and similar, for which
-- the parser reads the special syntax and returns an Exact RdrName
- --
- -- We are at a binding site for the name, so check first that it
+ -- We are at a binding site for the name, so check first that it
-- the current module is the correct one; otherwise GHC can get
- -- very confused indeed. This test rejects code like
+ -- very confused indeed. This test rejects code like
-- data T = (,) Int Int
-- unless we are in GHC.Tup
- = do checkErr (isInternalName name || this_mod == nameModule name)
+ ASSERT2( isExternalName name, ppr name )
+ do checkErr (this_mod == nameModule name)
(badOrigBinding rdr_name)
returnM name
+
| isOrig rdr_name
= do checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
(badOrigBinding 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) |
-- 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
lookupSyntaxName :: Name -- The standard name
-> RnM (Name, FreeVars) -- Possibly a non-standard name
lookupSyntaxName std_name
- = doptM Opt_NoImplicitPrelude `thenM` \ no_prelude ->
- if not no_prelude then normal_case
+ = doptM Opt_ImplicitPrelude `thenM` \ implicit_prelude ->
+ if implicit_prelude then normal_case
else
-- Get the similarly named thing from the local environment
lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
lookupSyntaxNames :: [Name] -- Standard names
-> RnM (ReboundNames Name, FreeVars) -- See comments with HsExpr.ReboundNames
lookupSyntaxNames std_names
- = doptM Opt_NoImplicitPrelude `thenM` \ no_prelude ->
- if not no_prelude then normal_case
+ = doptM Opt_ImplicitPrelude `thenM` \ implicit_prelude ->
+ if implicit_prelude then normal_case
else
-- Get the similarly named thing from the local environment
mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names `thenM` \ usr_names ->
(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) }
-------------------------------------
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
-- 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)
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]
projects / ghc-hetmet.git / blobdiff