import {-# SOURCE #-} RnHiFiles
+import FlattenInfo ( namesNeededForFlattening )
import HsSyn
import RdrHsSyn ( RdrNameIE, RdrNameHsType, extractHsTyRdrTyVars )
import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv,
ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv,
AvailInfo, Avails, GenAvailInfo(..), NameSupply(..),
- ModIface(..),
+ ModIface(..), GhciMode(..),
Deprecations(..), lookupDeprec,
extendLocalRdrEnv
)
import RnMonad
import Name ( Name,
getSrcLoc, nameIsLocalOrFrom,
- mkLocalName, mkGlobalName, nameModule,
+ mkInternalName, mkExternalName,
mkIPName, nameOccName, nameModule_maybe,
setNameModuleAndLoc
)
mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
import PrelNames ( mkUnboundName,
derivingOccurrences,
- mAIN_Name, pREL_MAIN_Name,
- ioTyConName, intTyConName,
+ mAIN_Name, main_RDR_Unqual,
+ runMainName, intTyConName,
boolTyConName, funTyConName,
unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
eqStringName, printName,
Nothing -> let
(us', us1) = splitUniqSupply (nsUniqs name_supply)
uniq = uniqFromSupply us1
- new_name = mkGlobalName uniq mod occ loc
+ new_name = mkExternalName uniq mod occ loc
new_cache = addToFM cache key new_name
in
setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
(us', us1) = splitUniqSupply (nsUniqs name_supply)
uniq = uniqFromSupply us1
mod = mkVanillaModule mod_name
- name = mkGlobalName uniq mod occ noSrcLoc
+ name = mkExternalName uniq mod occ noSrcLoc
new_cache = addToFM cache key name
newIPName rdr_name_ip
lookupOrigName :: RdrName -> RnM d Name
lookupOrigName rdr_name
- = ASSERT( isOrig rdr_name )
+ = -- NO: ASSERT( isOrig rdr_name )
+ -- Now that .hi-boot files are read by the main parser, they contain
+ -- ordinary qualified names (which we treat as Orig names here).
newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
lookupIfaceUnqual :: RdrName -> RnM d Name
-- These are all needed implicitly when compiling a statement
-- See TcModule.tc_stmts
-getImplicitModuleFVs mod_name decls -- Compiling a module
+getImplicitModuleFVs decls -- Compiling a module
= lookupOrigNames deriv_occs `thenRn` \ deriving_names ->
- returnRn (deriving_names `plusFV` implicit_main `plusFV` ubiquitousNames)
+ returnRn (deriving_names `plusFV` ubiquitousNames)
where
- -- Add occurrences for IO or PrimIO
- implicit_main | mod_name == mAIN_Name
- || mod_name == pREL_MAIN_Name = unitFV ioTyConName
- | otherwise = emptyFVs
-
-- deriv_classes is now a list of HsTypes, so a "normal" one
-- appears as a (HsClassP c []). The non-normal ones for the new
-- newtype-deriving extension, and they don't require any
-- 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!)
+ `plusFV`
+ namesNeededForFlattening
+ -- this will be empty unless flattening is activated
+
+checkMain ghci_mode mod_name gbl_env
+ -- LOOKUP main IF WE'RE IN MODULE Main
+ -- The main point of this is to drag in the declaration for 'main',
+ -- its in another module, and for the Prelude function 'runMain',
+ -- so that the type checker will find them
+ --
+ -- We have to return the main_name separately, because it's a
+ -- bona fide 'use', and should be recorded as such, but the others
+ -- aren't
+ | mod_name /= mAIN_Name
+ = returnRn (Nothing, emptyFVs, emptyFVs)
+
+ | not (main_RDR_Unqual `elemRdrEnv` gbl_env)
+ = complain_no_main `thenRn_`
+ returnRn (Nothing, emptyFVs, emptyFVs)
+
+ | otherwise
+ = lookupSrcName gbl_env main_RDR_Unqual `thenRn` \ main_name ->
+ returnRn (Just main_name, unitFV main_name, unitFV runMainName)
+
+ where
+ complain_no_main | ghci_mode == Interactive = addWarnRn noMainMsg
+ | otherwise = addErrRn noMainMsg
+ -- In interactive mode, only warn about the absence of main
\end{code}
%************************************************************************
let
(us', us1) = splitUniqSupply (nsUniqs name_supply)
uniqs = uniqsFromSupply us1
- names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
+ names = [ mkInternalName uniq (rdrNameOcc rdr_name) loc
| ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
]
in
let
(us', us1) = splitUniqSupply (nsUniqs name_supply)
uniq = uniqFromSupply us1
- name = mkLocalName uniq (rdrNameOcc rdr_name) loc
+ name = mkInternalName uniq (rdrNameOcc rdr_name) loc
in
setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_`
let
where
occ = nameOccName name
elt = GRE name (mk_provenance name) (lookupDeprec deprecs name)
-
-mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
--- Used to construct a GlobalRdrEnv for an interface that we've
--- read from a .hi file. We can't construct the original top-level
--- environment because we don't have enough info, but we compromise
--- by making an environment from its exports
-mkIfaceGlobalRdrEnv m_avails
- = foldl add emptyRdrEnv m_avails
- where
- add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True
- (\n -> LocalDef) avails NoDeprecs)
- -- The NoDeprecs is a bit of a hack I suppose
\end{code}
\begin{code}
quotes (ppr shadow),
ptext SLIT("shadows an existing binding")]
+noMainMsg = ptext SLIT("No 'main' defined in module Main")
+
unknownNameErr name
= sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]
where
projects / ghc-hetmet.git / blobdiff