PageRenderTime 33ms CodeModel.GetById 16ms RepoModel.GetById 0ms app.codeStats 0ms

/ghc-7.0.4/compiler/rename/RnEnv.lhs

http://picorec.googlecode.com/
Haskell | 1165 lines | 784 code | 153 blank | 228 comment | 36 complexity | 8fd8e676cb526afe6900179155367e00 MD5 | raw file
Possible License(s): BSD-3-Clause, BSD-2-Clause
  1. %
  2. % (c) The GRASP/AQUA Project, Glasgow University, 1992-2006
  3. %
  4. \section[RnEnv]{Environment manipulation for the renamer monad}
  5. \begin{code}
  6. module RnEnv (
  7. newTopSrcBinder, lookupFamInstDeclBndr,
  8. lookupLocatedTopBndrRn, lookupTopBndrRn,
  9. lookupLocatedOccRn, lookupOccRn,
  10. lookupLocatedGlobalOccRn,
  11. lookupGlobalOccRn, lookupGlobalOccRn_maybe,
  12. lookupLocalDataTcNames, lookupSigOccRn,
  13. lookupFixityRn, lookupTyFixityRn,
  14. lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
  15. lookupSyntaxName, lookupSyntaxTable,
  16. lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
  17. getLookupOccRn, addUsedRdrNames,
  18. newLocalBndrRn, newLocalBndrsRn, newIPNameRn,
  19. bindLocalName, bindLocalNames, bindLocalNamesFV,
  20. MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv,
  21. addLocalFixities,
  22. bindLocatedLocalsFV, bindLocatedLocalsRn,
  23. bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
  24. bindTyVarsRn, bindTyVarsFV, extendTyVarEnvFVRn,
  25. checkDupRdrNames, checkDupAndShadowedRdrNames,
  26. checkDupNames, checkDupAndShadowedNames,
  27. addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
  28. warnUnusedMatches,
  29. warnUnusedTopBinds, warnUnusedLocalBinds,
  30. dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg
  31. ) where
  32. #include "HsVersions.h"
  33. import LoadIface ( loadInterfaceForName, loadSrcInterface )
  34. import IfaceEnv ( lookupOrig, newGlobalBinder, newIPName )
  35. import HsSyn
  36. import RdrHsSyn ( extractHsTyRdrTyVars )
  37. import RdrName
  38. import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity)
  39. import TcEnv ( tcLookupDataCon, tcLookupField, isBrackStage )
  40. import TcRnMonad
  41. import Id ( isRecordSelector )
  42. import Name ( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
  43. nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName )
  44. import NameSet
  45. import NameEnv
  46. import UniqFM
  47. import DataCon ( dataConFieldLabels )
  48. import OccName
  49. import PrelNames ( mkUnboundName, rOOT_MAIN, iNTERACTIVE,
  50. consDataConKey, forall_tv_RDR )
  51. import Unique
  52. import BasicTypes
  53. import ErrUtils ( Message )
  54. import SrcLoc
  55. import Outputable
  56. import Util
  57. import Maybes
  58. import ListSetOps ( removeDups )
  59. import DynFlags
  60. import FastString
  61. import Control.Monad
  62. import Data.List
  63. import qualified Data.Set as Set
  64. \end{code}
  65. \begin{code}
  66. -- XXX
  67. thenM :: Monad a => a b -> (b -> a c) -> a c
  68. thenM = (>>=)
  69. \end{code}
  70. %*********************************************************
  71. %* *
  72. Source-code binders
  73. %* *
  74. %*********************************************************
  75. \begin{code}
  76. newTopSrcBinder :: Located RdrName -> RnM Name
  77. newTopSrcBinder (L loc rdr_name)
  78. | Just name <- isExact_maybe rdr_name
  79. = -- This is here to catch
  80. -- (a) Exact-name binders created by Template Haskell
  81. -- (b) The PrelBase defn of (say) [] and similar, for which
  82. -- the parser reads the special syntax and returns an Exact RdrName
  83. -- We are at a binding site for the name, so check first that it
  84. -- the current module is the correct one; otherwise GHC can get
  85. -- very confused indeed. This test rejects code like
  86. -- data T = (,) Int Int
  87. -- unless we are in GHC.Tup
  88. ASSERT2( isExternalName name, ppr name )
  89. do { this_mod <- getModule
  90. ; unless (this_mod == nameModule name)
  91. (addErrAt loc (badOrigBinding rdr_name))
  92. ; return name }
  93. | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
  94. = do { this_mod <- getModule
  95. ; unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
  96. (addErrAt loc (badOrigBinding rdr_name))
  97. -- When reading External Core we get Orig names as binders,
  98. -- but they should agree with the module gotten from the monad
  99. --
  100. -- We can get built-in syntax showing up here too, sadly. If you type
  101. -- data T = (,,,)
  102. -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon
  103. -- uses setRdrNameSpace to make it into a data constructors. At that point
  104. -- the nice Exact name for the TyCon gets swizzled to an Orig name.
  105. -- Hence the badOrigBinding error message.
  106. --
  107. -- Except for the ":Main.main = ..." definition inserted into
  108. -- the Main module; ugh!
  109. -- Because of this latter case, we call newGlobalBinder with a module from
  110. -- the RdrName, not from the environment. In principle, it'd be fine to
  111. -- have an arbitrary mixture of external core definitions in a single module,
  112. -- (apart from module-initialisation issues, perhaps).
  113. ; newGlobalBinder rdr_mod rdr_occ loc }
  114. --TODO, should pass the whole span
  115. | otherwise
  116. = do { unless (not (isQual rdr_name))
  117. (addErrAt loc (badQualBndrErr rdr_name))
  118. -- Binders should not be qualified; if they are, and with a different
  119. -- module name, we we get a confusing "M.T is not in scope" error later
  120. ; stage <- getStage
  121. ; if isBrackStage stage then
  122. -- We are inside a TH bracket, so make an *Internal* name
  123. -- See Note [Top-level Names in Template Haskell decl quotes] in RnNames
  124. do { uniq <- newUnique
  125. ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }
  126. else
  127. -- Normal case
  128. do { this_mod <- getModule
  129. ; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc } }
  130. \end{code}
  131. %*********************************************************
  132. %* *
  133. Source code occurrences
  134. %* *
  135. %*********************************************************
  136. Looking up a name in the RnEnv.
  137. Note [Type and class operator definitions]
  138. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  139. We want to reject all of these unless we have -XTypeOperators (Trac #3265)
  140. data a :*: b = ...
  141. class a :*: b where ...
  142. data (:*:) a b = ....
  143. class (:*:) a b where ...
  144. The latter two mean that we are not just looking for a
  145. *syntactically-infix* declaration, but one that uses an operator
  146. OccName. We use OccName.isSymOcc to detect that case, which isn't
  147. terribly efficient, but there seems to be no better way.
  148. \begin{code}
  149. lookupTopBndrRn :: RdrName -> RnM Name
  150. lookupTopBndrRn n = do nopt <- lookupTopBndrRn_maybe n
  151. case nopt of
  152. Just n' -> return n'
  153. Nothing -> do traceRn $ text "lookupTopBndrRn"
  154. unboundName n
  155. lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
  156. lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn
  157. lookupTopBndrRn_maybe :: RdrName -> RnM (Maybe Name)
  158. -- Look up a top-level source-code binder. We may be looking up an unqualified 'f',
  159. -- and there may be several imported 'f's too, which must not confuse us.
  160. -- For example, this is OK:
  161. -- import Foo( f )
  162. -- infix 9 f -- The 'f' here does not need to be qualified
  163. -- f x = x -- Nor here, of course
  164. -- So we have to filter out the non-local ones.
  165. --
  166. -- A separate function (importsFromLocalDecls) reports duplicate top level
  167. -- decls, so here it's safe just to choose an arbitrary one.
  168. --
  169. -- There should never be a qualified name in a binding position in Haskell,
  170. -- but there can be if we have read in an external-Core file.
  171. -- The Haskell parser checks for the illegal qualified name in Haskell
  172. -- source files, so we don't need to do so here.
  173. lookupTopBndrRn_maybe rdr_name
  174. | Just name <- isExact_maybe rdr_name
  175. = return (Just name)
  176. | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
  177. -- This deals with the case of derived bindings, where
  178. -- we don't bother to call newTopSrcBinder first
  179. -- We assume there is no "parent" name
  180. = do { loc <- getSrcSpanM
  181. ; n <- newGlobalBinder rdr_mod rdr_occ loc
  182. ; return (Just n)}
  183. | otherwise
  184. = do { -- Check for operators in type or class declarations
  185. -- See Note [Type and class operator definitions]
  186. let occ = rdrNameOcc rdr_name
  187. ; when (isTcOcc occ && isSymOcc occ)
  188. (do { op_ok <- xoptM Opt_TypeOperators
  189. ; unless op_ok (addErr (opDeclErr rdr_name)) })
  190. ; mb_gre <- lookupGreLocalRn rdr_name
  191. ; case mb_gre of
  192. Nothing -> return Nothing
  193. Just gre -> return (Just $ gre_name gre) }
  194. -----------------------------------------------
  195. lookupInstDeclBndr :: Name -> RdrName -> RnM Name
  196. -- This is called on the method name on the left-hand side of an
  197. -- instance declaration binding. eg. instance Functor T where
  198. -- fmap = ...
  199. -- ^^^^ called on this
  200. -- Regardless of how many unqualified fmaps are in scope, we want
  201. -- the one that comes from the Functor class.
  202. --
  203. -- Furthermore, note that we take no account of whether the
  204. -- name is only in scope qualified. I.e. even if method op is
  205. -- in scope as M.op, we still allow plain 'op' on the LHS of
  206. -- an instance decl
  207. lookupInstDeclBndr cls rdr
  208. = do { when (isQual rdr)
  209. (addErr (badQualBndrErr rdr))
  210. -- In an instance decl you aren't allowed
  211. -- to use a qualified name for the method
  212. -- (Although it'd make perfect sense.)
  213. ; lookupSubBndr (ParentIs cls) doc rdr }
  214. where
  215. doc = ptext (sLit "method of class") <+> quotes (ppr cls)
  216. -----------------------------------------------
  217. lookupConstructorFields :: Name -> RnM [Name]
  218. -- Look up the fields of a given constructor
  219. -- * For constructors from this module, use the record field env,
  220. -- which is itself gathered from the (as yet un-typechecked)
  221. -- data type decls
  222. --
  223. -- * For constructors from imported modules, use the *type* environment
  224. -- since imported modles are already compiled, the info is conveniently
  225. -- right there
  226. lookupConstructorFields con_name
  227. = do { this_mod <- getModule
  228. ; if nameIsLocalOrFrom this_mod con_name then
  229. do { RecFields field_env _ <- getRecFieldEnv
  230. ; return (lookupNameEnv field_env con_name `orElse` []) }
  231. else
  232. do { con <- tcLookupDataCon con_name
  233. ; return (dataConFieldLabels con) } }
  234. -----------------------------------------------
  235. -- Used for record construction and pattern matching
  236. -- When the -XDisambiguateRecordFields flag is on, take account of the
  237. -- constructor name to disambiguate which field to use; it's just the
  238. -- same as for instance decls
  239. --
  240. -- NB: Consider this:
  241. -- module Foo where { data R = R { fld :: Int } }
  242. -- module Odd where { import Foo; fld x = x { fld = 3 } }
  243. -- Arguably this should work, because the reference to 'fld' is
  244. -- unambiguous because there is only one field id 'fld' in scope.
  245. -- But currently it's rejected.
  246. lookupSubBndr :: Parent -- NoParent => just look it up as usual
  247. -- ParentIs p => use p to disambiguate
  248. -> SDoc -> RdrName
  249. -> RnM Name
  250. lookupSubBndr parent doc rdr_name
  251. | Just n <- isExact_maybe rdr_name -- This happens in derived code
  252. = return n
  253. | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
  254. = lookupOrig rdr_mod rdr_occ
  255. | otherwise -- Find all the things the rdr-name maps to
  256. = do { -- and pick the one with the right parent name
  257. ; env <- getGlobalRdrEnv
  258. ; let gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
  259. ; case pick parent gres of
  260. -- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
  261. -- The latter does pickGREs, but we want to allow 'x'
  262. -- even if only 'M.x' is in scope
  263. [gre] -> do { addUsedRdrNames (used_rdr_names gre)
  264. ; return (gre_name gre) }
  265. [] -> do { addErr (unknownSubordinateErr doc rdr_name)
  266. ; traceRn (text "RnEnv.lookup_sub_bndr" <+> (ppr rdr_name $$ ppr gres))
  267. ; return (mkUnboundName rdr_name) }
  268. gres -> do { addNameClashErrRn rdr_name gres
  269. ; return (gre_name (head gres)) } }
  270. where
  271. pick NoParent gres -- Normal lookup
  272. = pickGREs rdr_name gres
  273. pick (ParentIs p) gres -- Disambiguating lookup
  274. | isUnqual rdr_name = filter (right_parent p) gres
  275. | otherwise = filter (right_parent p) (pickGREs rdr_name gres)
  276. right_parent p (GRE { gre_par = ParentIs p' }) = p==p'
  277. right_parent _ _ = False
  278. -- Note [Usage for sub-bndrs]
  279. used_rdr_names gre
  280. | isQual rdr_name = [rdr_name]
  281. | otherwise = case gre_prov gre of
  282. LocalDef -> [rdr_name]
  283. Imported is -> map mk_qual_rdr is
  284. mk_qual_rdr imp_spec = mkRdrQual (is_as (is_decl imp_spec)) rdr_occ
  285. rdr_occ = rdrNameOcc rdr_name
  286. newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
  287. newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
  288. -- If the family is declared locally, it will not yet be in the main
  289. -- environment; hence, we pass in an extra one here, which we check first.
  290. -- See "Note [Looking up family names in family instances]" in 'RnNames'.
  291. --
  292. lookupFamInstDeclBndr :: GlobalRdrEnv -> Located RdrName -> RnM Name
  293. lookupFamInstDeclBndr tyclGroupEnv (L loc rdr_name)
  294. = setSrcSpan loc $
  295. case lookupGRE_RdrName rdr_name tyclGroupEnv of
  296. (gre:_) -> return $ gre_name gre
  297. -- if there is more than one, an error will be raised elsewhere
  298. [] -> lookupOccRn rdr_name
  299. \end{code}
  300. Note [Usage for sub-bndrs]
  301. ~~~~~~~~~~~~~~~~~~~~~~~~~~
  302. If you have this
  303. import qualified M( C( f ) )
  304. intance M.C T where
  305. f x = x
  306. then is the qualified import M.f used? Obviously yes.
  307. But the RdrName used in the instance decl is unqualified. In effect,
  308. we fill in the qualification by looking for f's whose class is M.C
  309. But when adding to the UsedRdrNames we must make that qualification
  310. explicit, otherwise we get "Redundant import of M.C".
  311. --------------------------------------------------
  312. -- Occurrences
  313. --------------------------------------------------
  314. \begin{code}
  315. getLookupOccRn :: RnM (Name -> Maybe Name)
  316. getLookupOccRn
  317. = getLocalRdrEnv `thenM` \ local_env ->
  318. return (lookupLocalRdrOcc local_env . nameOccName)
  319. lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
  320. lookupLocatedOccRn = wrapLocM lookupOccRn
  321. -- lookupOccRn looks up an occurrence of a RdrName
  322. lookupOccRn :: RdrName -> RnM Name
  323. lookupOccRn rdr_name
  324. = getLocalRdrEnv `thenM` \ local_env ->
  325. case lookupLocalRdrEnv local_env rdr_name of
  326. Just name -> return name
  327. Nothing -> lookupGlobalOccRn rdr_name
  328. lookupLocatedGlobalOccRn :: Located RdrName -> RnM (Located Name)
  329. lookupLocatedGlobalOccRn = wrapLocM lookupGlobalOccRn
  330. lookupGlobalOccRn :: RdrName -> RnM Name
  331. -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
  332. -- environment. Adds an error message if the RdrName is not in scope.
  333. -- Also has a special case for GHCi.
  334. lookupGlobalOccRn rdr_name
  335. = do { -- First look up the name in the normal environment.
  336. mb_name <- lookupGlobalOccRn_maybe rdr_name
  337. ; case mb_name of {
  338. Just n -> return n ;
  339. Nothing -> do
  340. { -- We allow qualified names on the command line to refer to
  341. -- *any* name exported by any module in scope, just as if there
  342. -- was an "import qualified M" declaration for every module.
  343. allow_qual <- doptM Opt_ImplicitImportQualified
  344. ; mod <- getModule
  345. -- This test is not expensive,
  346. -- and only happens for failed lookups
  347. ; if isQual rdr_name && allow_qual && mod == iNTERACTIVE
  348. then lookupQualifiedName rdr_name
  349. else unboundName rdr_name } } }
  350. lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
  351. -- No filter function; does not report an error on failure
  352. lookupGlobalOccRn_maybe rdr_name
  353. | Just n <- isExact_maybe rdr_name -- This happens in derived code
  354. = return (Just n)
  355. | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
  356. = do { n <- lookupOrig rdr_mod rdr_occ; return (Just n) }
  357. | otherwise
  358. = do { mb_gre <- lookupGreRn_maybe rdr_name
  359. ; case mb_gre of
  360. Nothing -> return Nothing
  361. Just gre -> return (Just (gre_name gre)) }
  362. unboundName :: RdrName -> RnM Name
  363. unboundName rdr_name
  364. = do { addErr (unknownNameErr rdr_name)
  365. ; env <- getGlobalRdrEnv;
  366. ; traceRn (vcat [unknownNameErr rdr_name,
  367. ptext (sLit "Global envt is:"),
  368. nest 3 (pprGlobalRdrEnv env)])
  369. ; return (mkUnboundName rdr_name) }
  370. --------------------------------------------------
  371. -- Lookup in the Global RdrEnv of the module
  372. --------------------------------------------------
  373. lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
  374. -- Just look up the RdrName in the GlobalRdrEnv
  375. lookupGreRn_maybe rdr_name
  376. = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
  377. lookupGreRn :: RdrName -> RnM GlobalRdrElt
  378. -- If not found, add error message, and return a fake GRE
  379. lookupGreRn rdr_name
  380. = do { mb_gre <- lookupGreRn_maybe rdr_name
  381. ; case mb_gre of {
  382. Just gre -> return gre ;
  383. Nothing -> do
  384. { traceRn $ text "lookupGreRn"
  385. ; name <- unboundName rdr_name
  386. ; return (GRE { gre_name = name, gre_par = NoParent,
  387. gre_prov = LocalDef }) }}}
  388. lookupGreLocalRn :: RdrName -> RnM (Maybe GlobalRdrElt)
  389. -- Similar, but restricted to locally-defined things
  390. lookupGreLocalRn rdr_name
  391. = lookupGreRn_help rdr_name lookup_fn
  392. where
  393. lookup_fn env = filter isLocalGRE (lookupGRE_RdrName rdr_name env)
  394. lookupGreRn_help :: RdrName -- Only used in error message
  395. -> (GlobalRdrEnv -> [GlobalRdrElt]) -- Lookup function
  396. -> RnM (Maybe GlobalRdrElt)
  397. -- Checks for exactly one match; reports deprecations
  398. -- Returns Nothing, without error, if too few
  399. lookupGreRn_help rdr_name lookup
  400. = do { env <- getGlobalRdrEnv
  401. ; case lookup env of
  402. [] -> return Nothing
  403. [gre] -> do { addUsedRdrName gre rdr_name
  404. ; return (Just gre) }
  405. gres -> do { addNameClashErrRn rdr_name gres
  406. ; return (Just (head gres)) } }
  407. addUsedRdrName :: GlobalRdrElt -> RdrName -> RnM ()
  408. -- Record usage of imported RdrNames
  409. addUsedRdrName gre rdr
  410. | isLocalGRE gre = return ()
  411. | otherwise = do { env <- getGblEnv
  412. ; updMutVar (tcg_used_rdrnames env)
  413. (\s -> Set.insert rdr s) }
  414. addUsedRdrNames :: [RdrName] -> RnM ()
  415. -- Record used sub-binders
  416. -- We don't check for imported-ness here, because it's inconvenient
  417. -- and not stritly necessary.
  418. addUsedRdrNames rdrs
  419. = do { env <- getGblEnv
  420. ; updMutVar (tcg_used_rdrnames env)
  421. (\s -> foldr Set.insert s rdrs) }
  422. ------------------------------
  423. -- GHCi support
  424. ------------------------------
  425. -- A qualified name on the command line can refer to any module at all: we
  426. -- try to load the interface if we don't already have it.
  427. lookupQualifiedName :: RdrName -> RnM Name
  428. lookupQualifiedName rdr_name
  429. | Just (mod,occ) <- isQual_maybe rdr_name
  430. -- Note: we want to behave as we would for a source file import here,
  431. -- and respect hiddenness of modules/packages, hence loadSrcInterface.
  432. = loadSrcInterface doc mod False Nothing `thenM` \ iface ->
  433. case [ (mod,occ) |
  434. (mod,avails) <- mi_exports iface,
  435. avail <- avails,
  436. name <- availNames avail,
  437. name == occ ] of
  438. ((mod,occ):ns) -> ASSERT (null ns)
  439. lookupOrig mod occ
  440. _ -> unboundName rdr_name
  441. | otherwise
  442. = pprPanic "RnEnv.lookupQualifiedName" (ppr rdr_name)
  443. where
  444. doc = ptext (sLit "Need to find") <+> ppr rdr_name
  445. \end{code}
  446. Note [Looking up signature names]
  447. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  448. lookupSigOccRn is used for type signatures and pragmas
  449. Is this valid?
  450. module A
  451. import M( f )
  452. f :: Int -> Int
  453. f x = x
  454. It's clear that the 'f' in the signature must refer to A.f
  455. The Haskell98 report does not stipulate this, but it will!
  456. So we must treat the 'f' in the signature in the same way
  457. as the binding occurrence of 'f', using lookupBndrRn
  458. However, consider this case:
  459. import M( f )
  460. f :: Int -> Int
  461. g x = x
  462. We don't want to say 'f' is out of scope; instead, we want to
  463. return the imported 'f', so that later on the reanamer will
  464. correctly report "misplaced type sig".
  465. \begin{code}
  466. lookupSigOccRn :: Maybe NameSet -- Just ns => these are the binders
  467. -- in the same group
  468. -- Nothing => signatures without
  469. -- binders are expected
  470. -- (a) top-level (SPECIALISE prags)
  471. -- (b) class decls
  472. -- (c) hs-boot files
  473. -> Sig RdrName
  474. -> Located RdrName -> RnM (Located Name)
  475. lookupSigOccRn mb_bound_names sig
  476. = wrapLocM $ \ rdr_name ->
  477. do { mb_name <- lookupBindGroupOcc mb_bound_names (hsSigDoc sig) rdr_name
  478. ; case mb_name of
  479. Left err -> do { addErr err; return (mkUnboundName rdr_name) }
  480. Right name -> return name }
  481. lookupBindGroupOcc :: Maybe NameSet -- See notes on the (Maybe NameSet)
  482. -> SDoc -- in lookupSigOccRn
  483. -> RdrName -> RnM (Either Message Name)
  484. -- Looks up the RdrName, expecting it to resolve to one of the
  485. -- bound names passed in. If not, return an appropriate error message
  486. --
  487. -- See Note [Looking up signature names]
  488. lookupBindGroupOcc mb_bound_names what rdr_name
  489. = do { local_env <- getLocalRdrEnv
  490. ; case lookupLocalRdrEnv local_env rdr_name of
  491. Just n -> check_local_name n
  492. Nothing -> do -- Not defined in a nested scope
  493. { env <- getGlobalRdrEnv
  494. ; let gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
  495. ; case (filter isLocalGRE gres) of
  496. (gre:_) -> check_local_name (gre_name gre)
  497. -- If there is more than one local GRE for the
  498. -- same OccName 'f', that will be reported separately
  499. -- as a duplicate top-level binding for 'f'
  500. [] | null gres -> bale_out_with empty
  501. | otherwise -> bale_out_with import_msg
  502. }}
  503. where
  504. check_local_name name -- The name is in scope, and not imported
  505. = case mb_bound_names of
  506. Just bound_names | not (name `elemNameSet` bound_names)
  507. -> bale_out_with local_msg
  508. _other -> return (Right name)
  509. bale_out_with msg
  510. = return (Left (sep [ ptext (sLit "The") <+> what
  511. <+> ptext (sLit "for") <+> quotes (ppr rdr_name)
  512. , nest 2 $ ptext (sLit "lacks an accompanying binding")]
  513. $$ nest 2 msg))
  514. local_msg = parens $ ptext (sLit "The") <+> what <+> ptext (sLit "must be given where")
  515. <+> quotes (ppr rdr_name) <+> ptext (sLit "is declared")
  516. import_msg = parens $ ptext (sLit "You cannot give a") <+> what
  517. <+> ptext (sLit "for an imported value")
  518. ---------------
  519. lookupLocalDataTcNames :: NameSet -> SDoc -> RdrName -> RnM [Name]
  520. -- GHC extension: look up both the tycon and data con
  521. -- for con-like things
  522. -- Complain if neither is in scope
  523. lookupLocalDataTcNames bound_names what rdr_name
  524. | Just n <- isExact_maybe rdr_name
  525. -- Special case for (:), which doesn't get into the GlobalRdrEnv
  526. = return [n] -- For this we don't need to try the tycon too
  527. | otherwise
  528. = do { mb_gres <- mapM (lookupBindGroupOcc (Just bound_names) what)
  529. (dataTcOccs rdr_name)
  530. ; let (errs, names) = splitEithers mb_gres
  531. ; when (null names) (addErr (head errs)) -- Bleat about one only
  532. ; return names }
  533. dataTcOccs :: RdrName -> [RdrName]
  534. -- If the input is a data constructor, return both it and a type
  535. -- constructor. This is useful when we aren't sure which we are
  536. -- looking at.
  537. dataTcOccs rdr_name
  538. | Just n <- isExact_maybe rdr_name -- Ghastly special case
  539. , n `hasKey` consDataConKey = [rdr_name] -- see note below
  540. | isDataOcc occ = [rdr_name, rdr_name_tc]
  541. | otherwise = [rdr_name]
  542. where
  543. occ = rdrNameOcc rdr_name
  544. rdr_name_tc = setRdrNameSpace rdr_name tcName
  545. -- If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
  546. -- and setRdrNameSpace generates an Orig, which is fine
  547. -- But it's not fine for (:), because there *is* no corresponding type
  548. -- constructor. If we generate an Orig tycon for GHC.Base.(:), it'll
  549. -- appear to be in scope (because Orig's simply allocate a new name-cache
  550. -- entry) and then we get an error when we use dataTcOccs in
  551. -- TcRnDriver.tcRnGetInfo. Large sigh.
  552. \end{code}
  553. %*********************************************************
  554. %* *
  555. Fixities
  556. %* *
  557. %*********************************************************
  558. \begin{code}
  559. --------------------------------
  560. type FastStringEnv a = UniqFM a -- Keyed by FastString
  561. emptyFsEnv :: FastStringEnv a
  562. lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a
  563. extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a
  564. emptyFsEnv = emptyUFM
  565. lookupFsEnv = lookupUFM
  566. extendFsEnv = addToUFM
  567. --------------------------------
  568. type MiniFixityEnv = FastStringEnv (Located Fixity)
  569. -- Mini fixity env for the names we're about
  570. -- to bind, in a single binding group
  571. --
  572. -- It is keyed by the *FastString*, not the *OccName*, because
  573. -- the single fixity decl infix 3 T
  574. -- affects both the data constructor T and the type constrctor T
  575. --
  576. -- We keep the location so that if we find
  577. -- a duplicate, we can report it sensibly
  578. --------------------------------
  579. -- Used for nested fixity decls to bind names along with their fixities.
  580. -- the fixities are given as a UFM from an OccName's FastString to a fixity decl
  581. addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
  582. addLocalFixities mini_fix_env names thing_inside
  583. = extendFixityEnv (mapCatMaybes find_fixity names) thing_inside
  584. where
  585. find_fixity name
  586. = case lookupFsEnv mini_fix_env (occNameFS occ) of
  587. Just (L _ fix) -> Just (name, FixItem occ fix)
  588. Nothing -> Nothing
  589. where
  590. occ = nameOccName name
  591. \end{code}
  592. --------------------------------
  593. lookupFixity is a bit strange.
  594. * Nested local fixity decls are put in the local fixity env, which we
  595. find with getFixtyEnv
  596. * Imported fixities are found in the HIT or PIT
  597. * Top-level fixity decls in this module may be for Names that are
  598. either Global (constructors, class operations)
  599. or Local/Exported (everything else)
  600. (See notes with RnNames.getLocalDeclBinders for why we have this split.)
  601. We put them all in the local fixity environment
  602. \begin{code}
  603. lookupFixityRn :: Name -> RnM Fixity
  604. lookupFixityRn name
  605. = getModule `thenM` \ this_mod ->
  606. if nameIsLocalOrFrom this_mod name
  607. then do -- It's defined in this module
  608. local_fix_env <- getFixityEnv
  609. traceRn (text "lookupFixityRn: looking up name in local environment:" <+>
  610. vcat [ppr name, ppr local_fix_env])
  611. return $ lookupFixity local_fix_env name
  612. else -- It's imported
  613. -- For imported names, we have to get their fixities by doing a
  614. -- loadInterfaceForName, and consulting the Ifaces that comes back
  615. -- from that, because the interface file for the Name might not
  616. -- have been loaded yet. Why not? Suppose you import module A,
  617. -- which exports a function 'f', thus;
  618. -- module CurrentModule where
  619. -- import A( f )
  620. -- module A( f ) where
  621. -- import B( f )
  622. -- Then B isn't loaded right away (after all, it's possible that
  623. -- nothing from B will be used). When we come across a use of
  624. -- 'f', we need to know its fixity, and it's then, and only
  625. -- then, that we load B.hi. That is what's happening here.
  626. --
  627. -- loadInterfaceForName will find B.hi even if B is a hidden module,
  628. -- and that's what we want.
  629. loadInterfaceForName doc name `thenM` \ iface -> do {
  630. traceRn (text "lookupFixityRn: looking up name in iface cache and found:" <+>
  631. vcat [ppr name, ppr $ mi_fix_fn iface (nameOccName name)]);
  632. return (mi_fix_fn iface (nameOccName name))
  633. }
  634. where
  635. doc = ptext (sLit "Checking fixity for") <+> ppr name
  636. ---------------
  637. lookupTyFixityRn :: Located Name -> RnM Fixity
  638. lookupTyFixityRn (L _ n) = lookupFixityRn n
  639. \end{code}
  640. %************************************************************************
  641. %* *
  642. Rebindable names
  643. Dealing with rebindable syntax is driven by the
  644. Opt_RebindableSyntax dynamic flag.
  645. In "deriving" code we don't want to use rebindable syntax
  646. so we switch off the flag locally
  647. %* *
  648. %************************************************************************
  649. Haskell 98 says that when you say "3" you get the "fromInteger" from the
  650. Standard Prelude, regardless of what is in scope. However, to experiment
  651. with having a language that is less coupled to the standard prelude, we're
  652. trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
  653. happens to be in scope. Then you can
  654. import Prelude ()
  655. import MyPrelude as Prelude
  656. to get the desired effect.
  657. At the moment this just happens for
  658. * fromInteger, fromRational on literals (in expressions and patterns)
  659. * negate (in expressions)
  660. * minus (arising from n+k patterns)
  661. * "do" notation
  662. We store the relevant Name in the HsSyn tree, in
  663. * HsIntegral/HsFractional/HsIsString
  664. * NegApp
  665. * NPlusKPat
  666. * HsDo
  667. respectively. Initially, we just store the "standard" name (PrelNames.fromIntegralName,
  668. fromRationalName etc), but the renamer changes this to the appropriate user
  669. name if Opt_NoImplicitPrelude is on. That is what lookupSyntaxName does.
  670. We treat the orignal (standard) names as free-vars too, because the type checker
  671. checks the type of the user thing against the type of the standard thing.
  672. \begin{code}
  673. lookupSyntaxName :: Name -- The standard name
  674. -> RnM (SyntaxExpr Name, FreeVars) -- Possibly a non-standard name
  675. lookupSyntaxName std_name
  676. = xoptM Opt_RebindableSyntax `thenM` \ rebindable_on ->
  677. if not rebindable_on then normal_case
  678. else
  679. -- Get the similarly named thing from the local environment
  680. lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
  681. return (HsVar usr_name, unitFV usr_name)
  682. where
  683. normal_case = return (HsVar std_name, emptyFVs)
  684. lookupSyntaxTable :: [Name] -- Standard names
  685. -> RnM (SyntaxTable Name, FreeVars) -- See comments with HsExpr.ReboundNames
  686. lookupSyntaxTable std_names
  687. = xoptM Opt_RebindableSyntax `thenM` \ rebindable_on ->
  688. if not rebindable_on then normal_case
  689. else
  690. -- Get the similarly named thing from the local environment
  691. mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names `thenM` \ usr_names ->
  692. return (std_names `zip` map HsVar usr_names, mkFVs usr_names)
  693. where
  694. normal_case = return (std_names `zip` map HsVar std_names, emptyFVs)
  695. \end{code}
  696. %*********************************************************
  697. %* *
  698. \subsection{Binding}
  699. %* *
  700. %*********************************************************
  701. \begin{code}
  702. newLocalBndrRn :: Located RdrName -> RnM Name
  703. -- Used for non-top-level binders. These should
  704. -- never be qualified.
  705. newLocalBndrRn (L loc rdr_name)
  706. | Just name <- isExact_maybe rdr_name
  707. = return name -- This happens in code generated by Template Haskell
  708. -- although I'm not sure why. Perhpas it's the call
  709. -- in RnPat.newName LetMk?
  710. | otherwise
  711. = do { unless (isUnqual rdr_name)
  712. (addErrAt loc (badQualBndrErr rdr_name))
  713. ; uniq <- newUnique
  714. ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }
  715. newLocalBndrsRn :: [Located RdrName] -> RnM [Name]
  716. newLocalBndrsRn = mapM newLocalBndrRn
  717. ---------------------
  718. bindLocatedLocalsRn :: [Located RdrName]
  719. -> ([Name] -> RnM a)
  720. -> RnM a
  721. bindLocatedLocalsRn rdr_names_w_loc enclosed_scope
  722. = do { checkDupAndShadowedRdrNames rdr_names_w_loc
  723. -- Make fresh Names and extend the environment
  724. ; names <- newLocalBndrsRn rdr_names_w_loc
  725. ; bindLocalNames names (enclosed_scope names) }
  726. bindLocalNames :: [Name] -> RnM a -> RnM a
  727. bindLocalNames names enclosed_scope
  728. = do { name_env <- getLocalRdrEnv
  729. ; setLocalRdrEnv (extendLocalRdrEnvList name_env names)
  730. enclosed_scope }
  731. bindLocalName :: Name -> RnM a -> RnM a
  732. bindLocalName name enclosed_scope
  733. = do { name_env <- getLocalRdrEnv
  734. ; setLocalRdrEnv (extendLocalRdrEnv name_env name)
  735. enclosed_scope }
  736. bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
  737. bindLocalNamesFV names enclosed_scope
  738. = do { (result, fvs) <- bindLocalNames names enclosed_scope
  739. ; return (result, delFVs names fvs) }
  740. -------------------------------------
  741. -- binLocalsFVRn is the same as bindLocalsRn
  742. -- except that it deals with free vars
  743. bindLocatedLocalsFV :: [Located RdrName]
  744. -> ([Name] -> RnM (a,FreeVars)) -> RnM (a, FreeVars)
  745. bindLocatedLocalsFV rdr_names enclosed_scope
  746. = bindLocatedLocalsRn rdr_names $ \ names ->
  747. enclosed_scope names `thenM` \ (thing, fvs) ->
  748. return (thing, delFVs names fvs)
  749. -------------------------------------
  750. bindTyVarsFV :: [LHsTyVarBndr RdrName]
  751. -> ([LHsTyVarBndr Name] -> RnM (a, FreeVars))
  752. -> RnM (a, FreeVars)
  753. bindTyVarsFV tyvars thing_inside
  754. = bindTyVarsRn tyvars $ \ tyvars' ->
  755. do { (res, fvs) <- thing_inside tyvars'
  756. ; return (res, delFVs (map hsLTyVarName tyvars') fvs) }
  757. bindTyVarsRn :: [LHsTyVarBndr RdrName]
  758. -> ([LHsTyVarBndr Name] -> RnM a)
  759. -> RnM a
  760. -- Haskell-98 binding of type variables; e.g. within a data type decl
  761. bindTyVarsRn tyvar_names enclosed_scope
  762. = bindLocatedLocalsRn located_tyvars $ \ names ->
  763. do { kind_sigs_ok <- xoptM Opt_KindSignatures
  764. ; unless (null kinded_tyvars || kind_sigs_ok)
  765. (mapM_ (addErr . kindSigErr) kinded_tyvars)
  766. ; enclosed_scope (zipWith replace tyvar_names names) }
  767. where
  768. replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
  769. located_tyvars = hsLTyVarLocNames tyvar_names
  770. kinded_tyvars = [n | L _ (KindedTyVar n _) <- tyvar_names]
  771. bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
  772. -- Find the type variables in the pattern type
  773. -- signatures that must be brought into scope
  774. bindPatSigTyVars tys thing_inside
  775. = do { scoped_tyvars <- xoptM Opt_ScopedTypeVariables
  776. ; if not scoped_tyvars then
  777. thing_inside []
  778. else
  779. do { name_env <- getLocalRdrEnv
  780. ; let locd_tvs = [ tv | ty <- tys
  781. , tv <- extractHsTyRdrTyVars ty
  782. , not (unLoc tv `elemLocalRdrEnv` name_env) ]
  783. nubbed_tvs = nubBy eqLocated locd_tvs
  784. -- The 'nub' is important. For example:
  785. -- f (x :: t) (y :: t) = ....
  786. -- We don't want to complain about binding t twice!
  787. ; bindLocatedLocalsRn nubbed_tvs thing_inside }}
  788. bindPatSigTyVarsFV :: [LHsType RdrName]
  789. -> RnM (a, FreeVars)
  790. -> RnM (a, FreeVars)
  791. bindPatSigTyVarsFV tys thing_inside
  792. = bindPatSigTyVars tys $ \ tvs ->
  793. thing_inside `thenM` \ (result,fvs) ->
  794. return (result, fvs `delListFromNameSet` tvs)
  795. bindSigTyVarsFV :: [Name]
  796. -> RnM (a, FreeVars)
  797. -> RnM (a, FreeVars)
  798. bindSigTyVarsFV tvs thing_inside
  799. = do { scoped_tyvars <- xoptM Opt_ScopedTypeVariables
  800. ; if not scoped_tyvars then
  801. thing_inside
  802. else
  803. bindLocalNamesFV tvs thing_inside }
  804. extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
  805. -- This function is used only in rnSourceDecl on InstDecl
  806. extendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside
  807. -------------------------------------
  808. checkDupRdrNames :: [Located RdrName] -> RnM ()
  809. checkDupRdrNames rdr_names_w_loc
  810. = -- Check for duplicated names in a binding group
  811. mapM_ (dupNamesErr getLoc) dups
  812. where
  813. (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
  814. checkDupNames :: [Name] -> RnM ()
  815. checkDupNames names
  816. = -- Check for duplicated names in a binding group
  817. mapM_ (dupNamesErr nameSrcSpan) dups
  818. where
  819. (_, dups) = removeDups (\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names
  820. ---------------------
  821. checkDupAndShadowedRdrNames :: [Located RdrName] -> RnM ()
  822. checkDupAndShadowedRdrNames loc_rdr_names
  823. = do { checkDupRdrNames loc_rdr_names
  824. ; envs <- getRdrEnvs
  825. ; checkShadowedOccs envs loc_occs }
  826. where
  827. loc_occs = [(loc,rdrNameOcc rdr) | L loc rdr <- loc_rdr_names]
  828. checkDupAndShadowedNames :: (GlobalRdrEnv, LocalRdrEnv) -> [Name] -> RnM ()
  829. checkDupAndShadowedNames envs names
  830. = do { checkDupNames names
  831. ; checkShadowedOccs envs loc_occs }
  832. where
  833. loc_occs = [(nameSrcSpan name, nameOccName name) | name <- names]
  834. -------------------------------------
  835. checkShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv) -> [(SrcSpan,OccName)] -> RnM ()
  836. checkShadowedOccs (global_env,local_env) loc_occs
  837. = ifDOptM Opt_WarnNameShadowing $
  838. do { traceRn (text "shadow" <+> ppr loc_occs)
  839. ; mapM_ check_shadow loc_occs }
  840. where
  841. check_shadow (loc, occ)
  842. | startsWithUnderscore occ = return () -- Do not report shadowing for "_x"
  843. -- See Trac #3262
  844. | Just n <- mb_local = complain [ptext (sLit "bound at") <+> ppr (nameSrcLoc n)]
  845. | otherwise = do { gres' <- filterM is_shadowed_gre gres
  846. ; complain (map pprNameProvenance gres') }
  847. where
  848. complain [] = return ()
  849. complain pp_locs = addWarnAt loc (shadowedNameWarn occ pp_locs)
  850. mb_local = lookupLocalRdrOcc local_env occ
  851. gres = lookupGRE_RdrName (mkRdrUnqual occ) global_env
  852. -- Make an Unqualified RdrName and look that up, so that
  853. -- we don't find any GREs that are in scope qualified-only
  854. is_shadowed_gre :: GlobalRdrElt -> RnM Bool
  855. -- Returns False for record selectors that are shadowed, when
  856. -- punning or wild-cards are on (cf Trac #2723)
  857. is_shadowed_gre gre@(GRE { gre_par = ParentIs _ })
  858. = do { dflags <- getDOpts
  859. ; if (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags)
  860. then do { is_fld <- is_rec_fld gre; return (not is_fld) }
  861. else return True }
  862. is_shadowed_gre _other = return True
  863. is_rec_fld gre -- Return True for record selector ids
  864. | isLocalGRE gre = do { RecFields _ fld_set <- getRecFieldEnv
  865. ; return (gre_name gre `elemNameSet` fld_set) }
  866. | otherwise = do { sel_id <- tcLookupField (gre_name gre)
  867. ; return (isRecordSelector sel_id) }
  868. \end{code}
  869. %************************************************************************
  870. %* *
  871. \subsection{Free variable manipulation}
  872. %* *
  873. %************************************************************************
  874. \begin{code}
  875. -- A useful utility
  876. addFvRn :: FreeVars -> RnM (thing, FreeVars) -> RnM (thing, FreeVars)
  877. addFvRn fvs1 thing_inside = do { (res, fvs2) <- thing_inside
  878. ; return (res, fvs1 `plusFV` fvs2) }
  879. mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
  880. mapFvRn f xs = do stuff <- mapM f xs
  881. case unzip stuff of
  882. (ys, fvs_s) -> return (ys, plusFVs fvs_s)
  883. mapMaybeFvRn :: (a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars)
  884. mapMaybeFvRn _ Nothing = return (Nothing, emptyFVs)
  885. mapMaybeFvRn f (Just x) = do { (y, fvs) <- f x; return (Just y, fvs) }
  886. -- because some of the rename functions are CPSed:
  887. -- maps the function across the list from left to right;
  888. -- collects all the free vars into one set
  889. mapFvRnCPS :: (a -> (b -> RnM c) -> RnM c)
  890. -> [a] -> ([b] -> RnM c) -> RnM c
  891. mapFvRnCPS _ [] cont = cont []
  892. mapFvRnCPS f (x:xs) cont = f x $ \ x' ->
  893. mapFvRnCPS f xs $ \ xs' ->
  894. cont (x':xs')
  895. \end{code}
  896. %************************************************************************
  897. %* *
  898. \subsection{Envt utility functions}
  899. %* *
  900. %************************************************************************
  901. \begin{code}
  902. warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
  903. warnUnusedTopBinds gres
  904. = ifDOptM Opt_WarnUnusedBinds
  905. $ do isBoot <- tcIsHsBoot
  906. let noParent gre = case gre_par gre of
  907. NoParent -> True
  908. ParentIs _ -> False
  909. -- Don't warn about unused bindings with parents in
  910. -- .hs-boot files, as you are sometimes required to give
  911. -- unused bindings (trac #3449).
  912. gres' = if isBoot then filter noParent gres
  913. else gres
  914. warnUnusedGREs gres'
  915. warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> FreeVars -> RnM ()
  916. warnUnusedLocalBinds = check_unused Opt_WarnUnusedBinds
  917. warnUnusedMatches = check_unused Opt_WarnUnusedMatches
  918. check_unused :: DynFlag -> [Name] -> FreeVars -> RnM ()
  919. check_unused flag bound_names used_names
  920. = ifDOptM flag (warnUnusedLocals (filterOut (`elemNameSet` used_names) bound_names))
  921. -------------------------
  922. -- Helpers
  923. warnUnusedGREs :: [GlobalRdrElt] -> RnM ()
  924. warnUnusedGREs gres
  925. = warnUnusedBinds [(n,p) | GRE {gre_name = n, gre_prov = p} <- gres]
  926. warnUnusedLocals :: [Name] -> RnM ()
  927. warnUnusedLocals names
  928. = warnUnusedBinds [(n,LocalDef) | n<-names]
  929. warnUnusedBinds :: [(Name,Provenance)] -> RnM ()
  930. warnUnusedBinds names = mapM_ warnUnusedName (filter reportable names)
  931. where reportable (name,_)
  932. | isWiredInName name = False -- Don't report unused wired-in names
  933. -- Otherwise we get a zillion warnings
  934. -- from Data.Tuple
  935. | otherwise = not (startsWithUnderscore (nameOccName name))
  936. -------------------------
  937. warnUnusedName :: (Name, Provenance) -> RnM ()
  938. warnUnusedName (name, LocalDef)
  939. = addUnusedWarning name (nameSrcSpan name)
  940. (ptext (sLit "Defined but not used"))
  941. warnUnusedName (name, Imported is)
  942. = mapM_ warn is
  943. where
  944. warn spec = addUnusedWarning name span msg
  945. where
  946. span = importSpecLoc spec
  947. pp_mod = quotes (ppr (importSpecModule spec))
  948. msg = ptext (sLit "Imported from") <+> pp_mod <+> ptext (sLit "but not used")
  949. addUnusedWarning :: Name -> SrcSpan -> SDoc -> RnM ()
  950. addUnusedWarning name span msg
  951. = addWarnAt span $
  952. sep [msg <> colon,
  953. nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
  954. <+> quotes (ppr name)]
  955. \end{code}
  956. \begin{code}
  957. addNameClashErrRn :: RdrName -> [GlobalRdrElt] -> RnM ()
  958. addNameClashErrRn rdr_name names
  959. = addErr (vcat [ptext (sLit "Ambiguous occurrence") <+> quotes (ppr rdr_name),
  960. ptext (sLit "It could refer to") <+> vcat (msg1 : msgs)])
  961. where
  962. (np1:nps) = names
  963. msg1 = ptext (sLit "either") <+> mk_ref np1
  964. msgs = [ptext (sLit " or") <+> mk_ref np | np <- nps]
  965. mk_ref gre = sep [quotes (ppr (gre_name gre)) <> comma, pprNameProvenance gre]
  966. shadowedNameWarn :: OccName -> [SDoc] -> SDoc
  967. shadowedNameWarn occ shadowed_locs
  968. = sep [ptext (sLit "This binding for") <+> quotes (ppr occ)
  969. <+> ptext (sLit "shadows the existing binding") <> plural shadowed_locs,
  970. nest 2 (vcat shadowed_locs)]
  971. unknownNameErr :: RdrName -> SDoc
  972. unknownNameErr rdr_name
  973. = vcat [ hang (ptext (sLit "Not in scope:"))
  974. 2 (pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
  975. <+> quotes (ppr rdr_name))
  976. , extra ]
  977. where
  978. extra | rdr_name == forall_tv_RDR = perhapsForallMsg
  979. | otherwise = empty
  980. perhapsForallMsg :: SDoc
  981. perhapsForallMsg
  982. = vcat [ ptext (sLit "Perhaps you intended to use -XExplicitForAll or similar flag")
  983. , ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")]
  984. unknownSubordinateErr :: SDoc -> RdrName -> SDoc
  985. unknownSubordinateErr doc op -- Doc is "method of class" or
  986. -- "field of constructor"
  987. = quotes (ppr op) <+> ptext (sLit "is not a (visible)") <+> doc
  988. badOrigBinding :: RdrName -> SDoc
  989. badOrigBinding name
  990. = ptext (sLit "Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
  991. -- The rdrNameOcc is because we don't want to print Prelude.(,)
  992. dupNamesErr :: Outputable n => (n -> SrcSpan) -> [n] -> RnM ()
  993. dupNamesErr get_loc names
  994. = addErrAt big_loc $
  995. vcat [ptext (sLit "Conflicting definitions for") <+> quotes (ppr (head names)),
  996. locations]
  997. where
  998. locs = map get_loc names
  999. big_loc = foldr1 combineSrcSpans locs
  1000. locations = ptext (sLit "Bound at:") <+> vcat (map ppr (sortLe (<=) locs))
  1001. kindSigErr :: Outputable a => a -> SDoc
  1002. kindSigErr thing
  1003. = hang (ptext (sLit "Illegal kind signature for") <+> quotes (ppr thing))
  1004. 2 (ptext (sLit "Perhaps you intended to use -XKindSignatures"))
  1005. badQualBndrErr :: RdrName -> SDoc
  1006. badQualBndrErr rdr_name
  1007. = ptext (sLit "Qualified name in binding position:") <+> ppr rdr_name
  1008. opDeclErr :: RdrName -> SDoc
  1009. opDeclErr n
  1010. = hang (ptext (sLit "Illegal declaration of a type or class operator") <+> quotes (ppr n))
  1011. 2 (ptext (sLit "Use -XTypeOperators to declare operators in type and declarations"))
  1012. \end{code}