isWiredInName, mkInternalName, mkExternalName, mkIPName,
nameSrcLoc, nameOccName, setNameSrcLoc, nameModule )
import NameSet
-import OccName ( OccName, tcName, isDataOcc, occNameUserString, occNameFlavour,
- reportIfUnused )
+import OccName ( OccName, tcName, isDataOcc, occNameFlavour, reportIfUnused )
import Module ( Module, ModuleName, moduleName, mkHomeModule,
lookupModuleEnv, lookupModuleEnvByName, extendModuleEnv_C )
import PrelNames ( mkUnboundName, intTyConName,
boolTyConName, funTyConName,
unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
- eqStringName, printName,
- bindIOName, returnIOName, failIOName, thenIOName
+ eqStringName, printName, integerTyConName,
+ bindIOName, returnIOName, failIOName, thenIOName,
+ rOOT_MAIN_Name
)
#ifdef GHCI
import DsMeta ( templateHaskellNames, qTyConName )
| Just name <- isExact_maybe rdr_name
= returnM name
- | otherwise
- = ASSERT( not (isOrig rdr_name) || rdrNameModule rdr_name == moduleName mod )
+ | isOrig rdr_name
+ = ASSERT( rdr_mod == moduleName mod || rdr_mod == rOOT_MAIN_Name )
-- When reading External Core we get Orig names as binders,
-- but they should agree with the module gotten from the monad
- newGlobalName mod (rdrNameOcc rdr_name) loc
+ --
+ -- Except for the ":Main.main = ..." definition inserted into
+ -- the Main module
+ --
+ -- Because of this latter case, we take the module from the RdrName,
+ -- not from the environment. In principle, it'd be fine to have an
+ -- arbitrary mixture of external core definitions in a single module,
+ -- (apart from module-initialisation issues, perhaps).
+ newGlobalName (mkHomeModule rdr_mod) (rdrNameOcc rdr_name) loc
+
+ | otherwise
+ = newGlobalName mod (rdrNameOcc rdr_name) loc
+ where
+ rdr_mod = rdrNameModule rdr_name
newGlobalName :: Module -> OccName -> SrcLoc -> TcRn m Name
newGlobalName mod occ loc
getGblEnv `thenM` \ gbl_env ->
let
avail_env = imp_env (tcg_imports gbl_env)
+ occ = rdrNameOcc rdr_name
in
- case lookupAvailEnv avail_env cls_name of
+ case lookupAvailEnv_maybe avail_env cls_name of
Nothing ->
-- If the class itself isn't in scope, then cls_name will
-- be unboundName, and there'll already be an error for
-- NB: qualified names are rejected by the parser
lookupOrigName rdr_name
- where
- occ = rdrNameOcc rdr_name
lookupSysBndr :: RdrName -> RnM Name
-- Used for the 'system binders' in a data type or class declaration
dataTcOccs :: RdrName -> [RdrName]
-- If the input is a data constructor, return both it and a type
-- constructor. This is useful when we aren't sure which we are
--- looking at
+-- looking at.
+--
+-- ToDo: If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
+-- and we don't have a systematic way to find the TyCon's Name from
+-- the DataCon's name. Sigh
dataTcOccs rdr_name
- | isDataOcc occ = [rdr_name, rdr_name_tc]
+ | isDataOcc occ = [rdr_name_tc, rdr_name]
| otherwise = [rdr_name]
where
occ = rdrNameOcc rdr_name
implicitStmtFVs source_fvs -- Compiling a statement
= stmt_fvs `plusFV` implicitModuleFVs source_fvs
where
- stmt_fvs = mkFVs [printName, bindIOName, thenIOName, returnIOName, failIOName]
+ stmt_fvs = mkFVs [printName, bindIOName, thenIOName, returnIOName, failIOName,
+ integerTyConName]
-- These are all needed implicitly when compiling a statement
-- See TcModule.tc_stmts
+ -- Reason for integerTyConName: consider this in GHCi
+ -- ghci> []
+ -- We get an ambigous constraint (Show a), which we now default just like
+ -- numeric types... but unless we have the instance decl for Integer we
+ -- won't find a valid default!
implicitModuleFVs source_fvs
= mkTemplateHaskellFVs source_fvs `plusFV`
lookupSyntaxName :: Name -- The standard name
-> RnM (Name, FreeVars) -- Possibly a non-standard name
lookupSyntaxName std_name
- = getModeRn `thenM` \ mode ->
- if isInterfaceMode mode then
- returnM (std_name, unitFV std_name)
- -- Happens for 'derived' code
- -- where we don't want to rebind
+ = doptM Opt_NoImplicitPrelude `thenM` \ no_prelude ->
+ if not no_prelude then normal_case
else
-
- doptM Opt_NoImplicitPrelude `thenM` \ no_prelude ->
- if not no_prelude then
- returnM (std_name, unitFV std_name) -- Normal case
-
+ getModeRn `thenM` \ mode ->
+ if isInterfaceMode mode then normal_case
+ -- Happens for 'derived' code where we don't want to rebind
else
-- Get the similarly named thing from the local environment
lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
returnM (usr_name, mkFVs [usr_name, std_name])
+ where
+ normal_case = returnM (std_name, unitFV std_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
+ else
+ getModeRn `thenM` \ mode ->
+ if isInterfaceMode mode then normal_case
+ else
+ -- Get the similarly named thing from the local environment
+ mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names `thenM` \ usr_names ->
+
+ returnM (std_names `zip` map HsVar usr_names, mkFVs std_names `plusFV` mkFVs usr_names)
+ where
+ normal_case = returnM (std_names `zip` map HsVar std_names, mkFVs std_names)
\end{code}
-- binLocalsFVRn is the same as bindLocalsRn
-- except that it deals with free vars
-bindLocalsFVRn doc rdr_names enclosed_scope
+bindLocalsFV doc rdr_names enclosed_scope
= bindLocalsRn doc rdr_names $ \ names ->
enclosed_scope names `thenM` \ (thing, fvs) ->
returnM (thing, delListFromNameSet fvs names)
bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
enclosed_scope (zipWith replaceTyVarName tyvar_names names)
-bindPatSigTyVars :: [RdrNameHsType]
- -> RnM (a, FreeVars)
- -> RnM (a, FreeVars)
+bindPatSigTyVars :: [RdrNameHsType] -> ([Name] -> RnM a) -> RnM a
-- Find the type variables in the pattern type
-- signatures that must be brought into scope
-bindPatSigTyVars tys enclosed_scope
+bindPatSigTyVars tys thing_inside
= getLocalRdrEnv `thenM` \ name_env ->
getSrcLocM `thenM` \ loc ->
let
located_tyvars = [(tv, loc) | tv <- forall_tyvars]
doc_sig = text "In a pattern type-signature"
in
- bindLocatedLocalsRn doc_sig located_tyvars $ \ names ->
- enclosed_scope `thenM` \ (thing, fvs) ->
- returnM (thing, delListFromNameSet fvs names)
+ bindLocatedLocalsRn doc_sig located_tyvars thing_inside
+bindPatSigTyVarsFV :: [RdrNameHsType]
+ -> RnM (a, FreeVars)
+ -> RnM (a, FreeVars)
+bindPatSigTyVarsFV tys thing_inside
+ = bindPatSigTyVars tys $ \ tvs ->
+ thing_inside `thenM` \ (result,fvs) ->
+ returnM (result, fvs `delListFromNameSet` tvs)
-------------------------------------
checkDupOrQualNames, checkDupNames :: SDoc
else Just parent,
gre_prov = mk_provenance name,
gre_deprec = lookupDeprec deprecs name}
-
\end{code}
\begin{code}
projects / ghc-hetmet.git / blobdiff