never executed always true always false
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE TypeFamilies #-}
3
4 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
5 {-
6
7 This module contains miscellaneous functions related to renaming.
8
9 -}
10
11 module GHC.Rename.Utils (
12 checkDupRdrNames, checkDupRdrNamesN, checkShadowedRdrNames,
13 checkDupNames, checkDupAndShadowedNames, dupNamesErr,
14 checkTupSize, checkCTupSize,
15 addFvRn, mapFvRn, mapMaybeFvRn,
16 warnUnusedMatches, warnUnusedTypePatterns,
17 warnUnusedTopBinds, warnUnusedLocalBinds,
18 checkUnusedRecordWildcard,
19 mkFieldEnv,
20 unknownSubordinateErr, badQualBndrErr, typeAppErr,
21 wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genAppType,
22 genHsIntegralLit, genHsTyLit,
23 HsDocContext(..), pprHsDocContext,
24 inHsDocContext, withHsDocContext,
25
26 newLocalBndrRn, newLocalBndrsRn,
27
28 bindLocalNames, bindLocalNamesFV,
29
30 addNameClashErrRn,
31
32 checkInferredVars,
33 noNestedForallsContextsErr, addNoNestedForallsContextsErr
34 )
35
36 where
37
38
39 import GHC.Prelude
40
41 import GHC.Core.Type
42 import GHC.Hs
43 import GHC.Types.Name.Reader
44 import GHC.Tc.Errors.Types
45 import GHC.Tc.Utils.Env
46 import GHC.Tc.Utils.Monad
47 import GHC.Types.Error
48 import GHC.Types.Name
49 import GHC.Types.Name.Set
50 import GHC.Types.Name.Env
51 import GHC.Core.DataCon
52 import GHC.Types.SrcLoc as SrcLoc
53 import GHC.Types.SourceFile
54 import GHC.Types.SourceText ( SourceText(..), IntegralLit )
55 import GHC.Utils.Outputable
56 import GHC.Utils.Panic
57 import GHC.Utils.Misc
58 import GHC.Types.Basic ( TopLevelFlag(..) )
59 import GHC.Data.List.SetOps ( removeDups )
60 import GHC.Data.Maybe ( whenIsJust )
61 import GHC.Driver.Session
62 import GHC.Data.FastString
63 import Control.Monad
64 import Data.List (find, sortBy)
65 import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
66 import qualified Data.List.NonEmpty as NE
67 import qualified GHC.LanguageExtensions as LangExt
68 import GHC.Data.Bag
69
70 {-
71 *********************************************************
72 * *
73 \subsection{Binding}
74 * *
75 *********************************************************
76 -}
77
78 newLocalBndrRn :: LocatedN RdrName -> RnM Name
79 -- Used for non-top-level binders. These should
80 -- never be qualified.
81 newLocalBndrRn (L loc rdr_name)
82 | Just name <- isExact_maybe rdr_name
83 = return name -- This happens in code generated by Template Haskell
84 -- See Note [Binders in Template Haskell] in "GHC.ThToHs"
85 | otherwise
86 = do { unless (isUnqual rdr_name)
87 (addErrAt (locA loc) (badQualBndrErr rdr_name))
88 ; uniq <- newUnique
89 ; return (mkInternalName uniq (rdrNameOcc rdr_name) (locA loc)) }
90
91 newLocalBndrsRn :: [LocatedN RdrName] -> RnM [Name]
92 newLocalBndrsRn = mapM newLocalBndrRn
93
94 bindLocalNames :: [Name] -> RnM a -> RnM a
95 bindLocalNames names enclosed_scope
96 = do { lcl_env <- getLclEnv
97 ; let th_level = thLevel (tcl_th_ctxt lcl_env)
98 th_bndrs' = extendNameEnvList (tcl_th_bndrs lcl_env)
99 [ (n, (NotTopLevel, th_level)) | n <- names ]
100 rdr_env' = extendLocalRdrEnvList (tcl_rdr lcl_env) names
101 ; setLclEnv (lcl_env { tcl_th_bndrs = th_bndrs'
102 , tcl_rdr = rdr_env' })
103 enclosed_scope }
104
105 bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
106 bindLocalNamesFV names enclosed_scope
107 = do { (result, fvs) <- bindLocalNames names enclosed_scope
108 ; return (result, delFVs names fvs) }
109
110 -------------------------------------
111 checkDupRdrNames :: [LocatedN RdrName] -> RnM ()
112 -- Check for duplicated names in a binding group
113 checkDupRdrNames rdr_names_w_loc
114 = mapM_ (dupNamesErr getLocA) dups
115 where
116 (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
117
118 checkDupRdrNamesN :: [LocatedN RdrName] -> RnM ()
119 -- Check for duplicated names in a binding group
120 checkDupRdrNamesN rdr_names_w_loc
121 = mapM_ (dupNamesErr getLocA) dups
122 where
123 (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
124
125 checkDupNames :: [Name] -> RnM ()
126 -- Check for duplicated names in a binding group
127 checkDupNames names = check_dup_names (filterOut isSystemName names)
128 -- See Note [Binders in Template Haskell] in "GHC.ThToHs"
129
130 check_dup_names :: [Name] -> RnM ()
131 check_dup_names names
132 = mapM_ (dupNamesErr nameSrcSpan) dups
133 where
134 (_, dups) = removeDups (\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names
135
136 ---------------------
137 checkShadowedRdrNames :: [LocatedN RdrName] -> RnM ()
138 checkShadowedRdrNames loc_rdr_names
139 = do { envs <- getRdrEnvs
140 ; checkShadowedOccs envs get_loc_occ filtered_rdrs }
141 where
142 filtered_rdrs = filterOut (isExact . unLoc) loc_rdr_names
143 -- See Note [Binders in Template Haskell] in "GHC.ThToHs"
144 get_loc_occ (L loc rdr) = (locA loc,rdrNameOcc rdr)
145
146 checkDupAndShadowedNames :: (GlobalRdrEnv, LocalRdrEnv) -> [Name] -> RnM ()
147 checkDupAndShadowedNames envs names
148 = do { check_dup_names filtered_names
149 ; checkShadowedOccs envs get_loc_occ filtered_names }
150 where
151 filtered_names = filterOut isSystemName names
152 -- See Note [Binders in Template Haskell] in "GHC.ThToHs"
153 get_loc_occ name = (nameSrcSpan name, nameOccName name)
154
155 -------------------------------------
156 checkShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv)
157 -> (a -> (SrcSpan, OccName))
158 -> [a] -> RnM ()
159 checkShadowedOccs (global_env,local_env) get_loc_occ ns
160 = whenWOptM Opt_WarnNameShadowing $
161 do { traceRn "checkShadowedOccs:shadow" (ppr (map get_loc_occ ns))
162 ; mapM_ check_shadow ns }
163 where
164 check_shadow n
165 | startsWithUnderscore occ = return () -- Do not report shadowing for "_x"
166 -- See #3262
167 | Just n <- mb_local = complain (ShadowedNameProvenanceLocal (nameSrcLoc n))
168 | otherwise = do { gres' <- filterM is_shadowed_gre gres
169 ; when (not . null $ gres') $ complain (ShadowedNameProvenanceGlobal gres') }
170 where
171 (loc,occ) = get_loc_occ n
172 mb_local = lookupLocalRdrOcc local_env occ
173 gres = lookupGRE_RdrName (mkRdrUnqual occ) global_env
174 -- Make an Unqualified RdrName and look that up, so that
175 -- we don't find any GREs that are in scope qualified-only
176
177 complain provenance = addDiagnosticAt loc (TcRnShadowedName occ provenance)
178
179 is_shadowed_gre :: GlobalRdrElt -> RnM Bool
180 -- Returns False for record selectors that are shadowed, when
181 -- punning or wild-cards are on (cf #2723)
182 is_shadowed_gre gre | isRecFldGRE gre
183 = do { dflags <- getDynFlags
184 ; return $ not (xopt LangExt.NamedFieldPuns dflags
185 || xopt LangExt.RecordWildCards dflags) }
186 is_shadowed_gre _other = return True
187
188 -------------------------------------
189 -- | Throw an error message if a user attempts to quantify an inferred type
190 -- variable in a place where specificity cannot be observed. For example,
191 -- @forall {a}. [a] -> [a]@ would be rejected to the inferred type variable
192 -- @{a}@, but @forall a. [a] -> [a]@ would be accepted.
193 -- See @Note [Unobservably inferred type variables]@.
194 checkInferredVars :: HsDocContext
195 -> Maybe SDoc
196 -- ^ The error msg if the signature is not allowed to contain
197 -- manually written inferred variables.
198 -> LHsSigType GhcPs
199 -> RnM ()
200 checkInferredVars _ Nothing _ = return ()
201 checkInferredVars ctxt (Just msg) ty =
202 let bndrs = sig_ty_bndrs ty
203 in case find ((==) InferredSpec . hsTyVarBndrFlag) bndrs of
204 Nothing -> return ()
205 Just _ -> addErr $ TcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg)
206 where
207 sig_ty_bndrs :: LHsSigType GhcPs -> [HsTyVarBndr Specificity GhcPs]
208 sig_ty_bndrs (L _ (HsSig{sig_bndrs = outer_bndrs}))
209 = map unLoc (hsOuterExplicitBndrs outer_bndrs)
210
211 {-
212 Note [Unobservably inferred type variables]
213 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
214 While GHC's parser allows the use of inferred type variables
215 (e.g., `forall {a}. <...>`) just about anywhere that type variable binders can
216 appear, there are some situations where the distinction between inferred and
217 specified type variables cannot be observed. For example, consider this
218 instance declaration:
219
220 instance forall {a}. Eq (T a) where ...
221
222 Making {a} inferred is pointless, as there is no way for user code to
223 "apply" an instance declaration in a way where the inferred/specified
224 distinction would make a difference. (Notably, there is no opportunity
225 for visible type application of an instance declaration.) Anyone who
226 writes such code is likely confused, so in an attempt to be helpful,
227 we emit an error message if a user writes code like this. The
228 checkInferredVars function is responsible for implementing this
229 restriction.
230
231 It turns out to be somewhat cumbersome to enforce this restriction in
232 certain cases. Specifically:
233
234 * Quantified constraints. In the type `f :: (forall {a}. C a) => Proxy Int`,
235 there is no way to observe that {a} is inferred. Nevertheless, actually
236 rejecting this code would be tricky, as we would need to reject
237 `forall {a}. <...>` as a constraint but *accept* other uses of
238 `forall {a}. <...>` as a type (e.g., `g :: (forall {a}. a -> a) -> b -> b`).
239 This is quite tedious to do in practice, so we don't bother.
240
241 * Default method type signatures (#18432). These are tricky because inferred
242 type variables can appear nested, e.g.,
243
244 class C a where
245 m :: forall b. a -> b -> forall c. c -> c
246 default m :: forall b. a -> b -> forall {c}. c -> c
247 m _ _ = id
248
249 Robustly checking for nested, inferred type variables ends up being a pain,
250 so we don't try to do this.
251
252 For now, we simply allow inferred quantifiers to be specified here,
253 even though doing so is pointless. All we lose is a warning.
254
255 Aside from the places where we already use checkInferredVars, most of
256 the other places where inferred vars don't make sense are in any case
257 already prohibited from having foralls /at all/. For example:
258
259 instance forall a. forall {b}. Eq (Either a b) where ...
260
261 Here the nested `forall {b}` is already prohibited. (See
262 Note [No nested foralls or contexts in instance types] in GHC.Hs.Type).
263 -}
264
265 -- | Examines a non-outermost type for @forall@s or contexts, which are assumed
266 -- to be nested. For example, in the following declaration:
267 --
268 -- @
269 -- instance forall a. forall b. C (Either a b)
270 -- @
271 --
272 -- The outermost @forall a@ is fine, but the nested @forall b@ is not. We
273 -- invoke 'noNestedForallsContextsErr' on the type @forall b. C (Either a b)@
274 -- to catch the nested @forall@ and create a suitable error message.
275 -- 'noNestedForallsContextsErr' returns @'Just' err_msg@ if such a @forall@ or
276 -- context is found, and returns @Nothing@ otherwise.
277 --
278 -- This is currently used in the following places:
279 --
280 -- * In GADT constructor types (in 'rnConDecl').
281 -- See @Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)@
282 -- in "GHC.Hs.Type".
283 --
284 -- * In instance declaration types (in 'rnClsIntDecl' and 'rnSrcDerivDecl' in
285 -- "GHC.Rename.Module" and 'renameSig' in "GHC.Rename.Bind").
286 -- See @Note [No nested foralls or contexts in instance types]@ in
287 -- "GHC.Hs.Type".
288 noNestedForallsContextsErr :: SDoc -> LHsType GhcRn -> Maybe (SrcSpan, SDoc)
289 noNestedForallsContextsErr what lty =
290 case ignoreParens lty of
291 L l (HsForAllTy { hst_tele = tele })
292 | HsForAllVis{} <- tele
293 -- The only two places where this function is called correspond to
294 -- types of terms, so we give a slightly more descriptive error
295 -- message in the event that they contain visible dependent
296 -- quantification (currently only allowed in kinds).
297 -> Just (locA l, vcat [ text "Illegal visible, dependent quantification" <+>
298 text "in the type of a term"
299 , text "(GHC does not yet support this)" ])
300 | HsForAllInvis{} <- tele
301 -> Just (locA l, nested_foralls_contexts_err)
302 L l (HsQualTy {})
303 -> Just (locA l, nested_foralls_contexts_err)
304 _ -> Nothing
305 where
306 nested_foralls_contexts_err =
307 what <+> text "cannot contain nested"
308 <+> quotes forAllLit <> text "s or contexts"
309
310 -- | A common way to invoke 'noNestedForallsContextsErr'.
311 addNoNestedForallsContextsErr :: HsDocContext -> SDoc -> LHsType GhcRn -> RnM ()
312 addNoNestedForallsContextsErr ctxt what lty =
313 whenIsJust (noNestedForallsContextsErr what lty) $ \(l, err_msg) ->
314 addErrAt l $ TcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt err_msg)
315
316 {-
317 ************************************************************************
318 * *
319 \subsection{Free variable manipulation}
320 * *
321 ************************************************************************
322 -}
323
324 -- A useful utility
325 addFvRn :: FreeVars -> RnM (thing, FreeVars) -> RnM (thing, FreeVars)
326 addFvRn fvs1 thing_inside = do { (res, fvs2) <- thing_inside
327 ; return (res, fvs1 `plusFV` fvs2) }
328
329 mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
330 mapFvRn f xs = do stuff <- mapM f xs
331 case unzip stuff of
332 (ys, fvs_s) -> return (ys, plusFVs fvs_s)
333
334 mapMaybeFvRn :: (a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars)
335 mapMaybeFvRn _ Nothing = return (Nothing, emptyFVs)
336 mapMaybeFvRn f (Just x) = do { (y, fvs) <- f x; return (Just y, fvs) }
337
338 {-
339 ************************************************************************
340 * *
341 \subsection{Envt utility functions}
342 * *
343 ************************************************************************
344 -}
345
346 warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
347 warnUnusedTopBinds gres
348 = whenWOptM Opt_WarnUnusedTopBinds
349 $ do env <- getGblEnv
350 let isBoot = tcg_src env == HsBootFile
351 let noParent gre = case gre_par gre of
352 NoParent -> True
353 _ -> False
354 -- Don't warn about unused bindings with parents in
355 -- .hs-boot files, as you are sometimes required to give
356 -- unused bindings (trac #3449).
357 -- HOWEVER, in a signature file, you are never obligated to put a
358 -- definition in the main text. Thus, if you define something
359 -- and forget to export it, we really DO want to warn.
360 gres' = if isBoot then filter noParent gres
361 else gres
362 warnUnusedGREs gres'
363
364
365 -- | Checks to see if we need to warn for -Wunused-record-wildcards or
366 -- -Wredundant-record-wildcards
367 checkUnusedRecordWildcard :: SrcSpan
368 -> FreeVars
369 -> Maybe [Name]
370 -> RnM ()
371 checkUnusedRecordWildcard _ _ Nothing = return ()
372 checkUnusedRecordWildcard loc _ (Just []) =
373 -- Add a new warning if the .. pattern binds no variables
374 setSrcSpan loc $ warnRedundantRecordWildcard
375 checkUnusedRecordWildcard loc fvs (Just dotdot_names) =
376 setSrcSpan loc $ warnUnusedRecordWildcard dotdot_names fvs
377
378
379 -- | Produce a warning when the `..` pattern binds no new
380 -- variables.
381 --
382 -- @
383 -- data P = P { x :: Int }
384 --
385 -- foo (P{x, ..}) = x
386 -- @
387 --
388 -- The `..` here doesn't bind any variables as `x` is already bound.
389 warnRedundantRecordWildcard :: RnM ()
390 warnRedundantRecordWildcard =
391 whenWOptM Opt_WarnRedundantRecordWildcards $
392 let msg = TcRnUnknownMessage $
393 mkPlainDiagnostic (WarningWithFlag Opt_WarnRedundantRecordWildcards)
394 noHints
395 redundantWildcardWarning
396 in addDiagnostic msg
397
398
399 -- | Produce a warning when no variables bound by a `..` pattern are used.
400 --
401 -- @
402 -- data P = P { x :: Int }
403 --
404 -- foo (P{..}) = ()
405 -- @
406 --
407 -- The `..` pattern binds `x` but it is not used in the RHS so we issue
408 -- a warning.
409 warnUnusedRecordWildcard :: [Name] -> FreeVars -> RnM ()
410 warnUnusedRecordWildcard ns used_names = do
411 let used = filter (`elemNameSet` used_names) ns
412 traceRn "warnUnused" (ppr ns $$ ppr used_names $$ ppr used)
413 warnIf (null used)
414 unusedRecordWildcardWarning
415
416
417
418 warnUnusedLocalBinds, warnUnusedMatches, warnUnusedTypePatterns
419 :: [Name] -> FreeVars -> RnM ()
420 warnUnusedLocalBinds = check_unused Opt_WarnUnusedLocalBinds
421 warnUnusedMatches = check_unused Opt_WarnUnusedMatches
422 warnUnusedTypePatterns = check_unused Opt_WarnUnusedTypePatterns
423
424 check_unused :: WarningFlag -> [Name] -> FreeVars -> RnM ()
425 check_unused flag bound_names used_names
426 = whenWOptM flag (warnUnused flag (filterOut (`elemNameSet` used_names)
427 bound_names))
428
429 -------------------------
430 -- Helpers
431 warnUnusedGREs :: [GlobalRdrElt] -> RnM ()
432 warnUnusedGREs gres = mapM_ warnUnusedGRE gres
433
434 -- NB the Names must not be the names of record fields!
435 warnUnused :: WarningFlag -> [Name] -> RnM ()
436 warnUnused flag names =
437 mapM_ (warnUnused1 flag . NormalGreName) names
438
439 warnUnused1 :: WarningFlag -> GreName -> RnM ()
440 warnUnused1 flag child
441 = when (reportable child) $
442 addUnusedWarning flag
443 (occName child) (greNameSrcSpan child)
444 (text $ "Defined but not used" ++ opt_str)
445 where
446 opt_str = case flag of
447 Opt_WarnUnusedTypePatterns -> " on the right hand side"
448 _ -> ""
449
450 warnUnusedGRE :: GlobalRdrElt -> RnM ()
451 warnUnusedGRE gre@(GRE { gre_lcl = lcl, gre_imp = is })
452 | lcl = warnUnused1 Opt_WarnUnusedTopBinds (gre_name gre)
453 | otherwise = when (reportable (gre_name gre)) (mapM_ warn is)
454 where
455 occ = greOccName gre
456 warn spec = addUnusedWarning Opt_WarnUnusedTopBinds occ span msg
457 where
458 span = importSpecLoc spec
459 pp_mod = quotes (ppr (importSpecModule spec))
460 msg = text "Imported from" <+> pp_mod <+> text "but not used"
461
462 -- | Make a map from selector names to field labels and parent tycon
463 -- names, to be used when reporting unused record fields.
464 mkFieldEnv :: GlobalRdrEnv -> NameEnv (FieldLabelString, Parent)
465 mkFieldEnv rdr_env = mkNameEnv [ (greMangledName gre, (flLabel fl, gre_par gre))
466 | gres <- nonDetOccEnvElts rdr_env
467 , gre <- gres
468 , Just fl <- [greFieldLabel gre]
469 ]
470
471 -- | Should we report the fact that this 'Name' is unused? The
472 -- 'OccName' may differ from 'nameOccName' due to
473 -- DuplicateRecordFields.
474 reportable :: GreName -> Bool
475 reportable child
476 | NormalGreName name <- child
477 , isWiredInName name = False -- Don't report unused wired-in names
478 -- Otherwise we get a zillion warnings
479 -- from Data.Tuple
480 | otherwise = not (startsWithUnderscore (occName child))
481
482 addUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM ()
483 addUnusedWarning flag occ span msg = do
484 let diag = TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints $
485 sep [msg <> colon,
486 nest 2 $ pprNonVarNameSpace (occNameSpace occ)
487 <+> quotes (ppr occ)]
488 addDiagnosticAt span diag
489
490 unusedRecordWildcardWarning :: TcRnMessage
491 unusedRecordWildcardWarning =
492 TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnUnusedRecordWildcards) noHints $
493 wildcardDoc $ text "No variables bound in the record wildcard match are used"
494
495 redundantWildcardWarning :: SDoc
496 redundantWildcardWarning =
497 wildcardDoc $ text "Record wildcard does not bind any new variables"
498
499 wildcardDoc :: SDoc -> SDoc
500 wildcardDoc herald =
501 herald
502 $$ nest 2 (text "Possible fix" <> colon <+> text "omit the"
503 <+> quotes (text ".."))
504
505 {-
506 Note [Skipping ambiguity errors at use sites of local declarations]
507 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
508 In general, we do not report ambiguous occurrences at use sites where all the
509 clashing names are defined locally, because the error will have been reported at
510 the definition site, and we want to avoid an error cascade.
511
512 However, when DuplicateRecordFields is enabled, it is possible to define the
513 same field name multiple times, so we *do* need to report an error at the use
514 site when there is ambiguity between multiple fields. Moreover, when
515 NoFieldSelectors is enabled, it is possible to define a field with the same name
516 as a non-field, so again we need to report ambiguity at the use site.
517
518 We can skip reporting an ambiguity error whenever defining the GREs must have
519 yielded a duplicate declarations error. More precisely, we can skip if:
520
521 * there are at least two non-fields amongst the GREs; or
522
523 * there are at least two fields amongst the GREs, and DuplicateRecordFields is
524 *disabled*; or
525
526 * there is at least one non-field, at least one field, and NoFieldSelectors is
527 *disabled*.
528
529 These conditions ensure that a duplicate local declaration will have been
530 reported. See also Note [Reporting duplicate local declarations] in
531 GHC.Rename.Names).
532
533 -}
534
535 addNameClashErrRn :: RdrName -> NE.NonEmpty GlobalRdrElt -> RnM ()
536 addNameClashErrRn rdr_name gres
537 | all isLocalGRE gres && can_skip
538 -- If there are two or more *local* defns, we'll usually have reported that
539 -- already, and we don't want an error cascade.
540 = return ()
541 | otherwise
542 = addErr $ TcRnUnknownMessage $ mkPlainError noHints $
543 (vcat [ text "Ambiguous occurrence" <+> quotes (ppr rdr_name)
544 , text "It could refer to"
545 , nest 3 (vcat (msg1 : msgs)) ])
546 where
547 np1 NE.:| nps = gres
548 msg1 = text "either" <+> ppr_gre np1
549 msgs = [text " or" <+> ppr_gre np | np <- nps]
550 ppr_gre gre = sep [ pp_greMangledName gre <> comma
551 , pprNameProvenance gre]
552
553 -- When printing the name, take care to qualify it in the same
554 -- way as the provenance reported by pprNameProvenance, namely
555 -- the head of 'gre_imp'. Otherwise we get confusing reports like
556 -- Ambiguous occurrence ‘null’
557 -- It could refer to either ‘T15487a.null’,
558 -- imported from ‘Prelude’ at T15487.hs:1:8-13
559 -- or ...
560 -- See #15487
561 pp_greMangledName gre@(GRE { gre_name = child
562 , gre_lcl = lcl, gre_imp = iss }) =
563 case child of
564 FieldGreName fl -> text "the field" <+> quotes (ppr fl)
565 NormalGreName name -> quotes (pp_qual name <> dot <> ppr (nameOccName name))
566 where
567 pp_qual name
568 | lcl
569 = ppr (nameModule name)
570 | Just imp <- headMaybe iss -- This 'imp' is the one that
571 -- pprNameProvenance chooses
572 , ImpDeclSpec { is_as = mod } <- is_decl imp
573 = ppr mod
574 | otherwise
575 = pprPanic "addNameClassErrRn" (ppr gre $$ ppr iss)
576 -- Invariant: either 'lcl' is True or 'iss' is non-empty
577
578 -- If all the GREs are defined locally, can we skip reporting an ambiguity
579 -- error at use sites, because it will have been reported already? See
580 -- Note [Skipping ambiguity errors at use sites of local declarations]
581 can_skip = num_non_flds >= 2
582 || (num_flds >= 2 && not (isDuplicateRecFldGRE (head flds)))
583 || (num_non_flds >= 1 && num_flds >= 1
584 && not (isNoFieldSelectorGRE (head flds)))
585 (flds, non_flds) = NE.partition isRecFldGRE gres
586 num_flds = length flds
587 num_non_flds = length non_flds
588
589
590 unknownSubordinateErr :: SDoc -> RdrName -> SDoc
591 unknownSubordinateErr doc op -- Doc is "method of class" or
592 -- "field of constructor"
593 = quotes (ppr op) <+> text "is not a (visible)" <+> doc
594
595
596 dupNamesErr :: Outputable n => (n -> SrcSpan) -> NE.NonEmpty n -> RnM ()
597 dupNamesErr get_loc names
598 = addErrAt big_loc $ TcRnUnknownMessage $ mkPlainError noHints $
599 vcat [text "Conflicting definitions for" <+> quotes (ppr (NE.head names)),
600 locations]
601 where
602 locs = map get_loc (NE.toList names)
603 big_loc = foldr1 combineSrcSpans locs
604 locations = text "Bound at:" <+> vcat (map ppr (sortBy SrcLoc.leftmost_smallest locs))
605
606 badQualBndrErr :: RdrName -> TcRnMessage
607 badQualBndrErr rdr_name
608 = TcRnUnknownMessage $ mkPlainError noHints $
609 text "Qualified name in binding position:" <+> ppr rdr_name
610
611 typeAppErr :: String -> LHsType GhcPs -> TcRnMessage
612 typeAppErr what (L _ k)
613 = TcRnUnknownMessage $ mkPlainError noHints $
614 hang (text "Illegal visible" <+> text what <+> text "application"
615 <+> quotes (char '@' <> ppr k))
616 2 (text "Perhaps you intended to use TypeApplications")
617
618 -- | Ensure that a boxed or unboxed tuple has arity no larger than
619 -- 'mAX_TUPLE_SIZE'.
620 checkTupSize :: Int -> TcM ()
621 checkTupSize tup_size
622 | tup_size <= mAX_TUPLE_SIZE
623 = return ()
624 | otherwise
625 = addErr $ TcRnUnknownMessage $ mkPlainError noHints $
626 sep [text "A" <+> int tup_size <> text "-tuple is too large for GHC",
627 nest 2 (parens (text "max size is" <+> int mAX_TUPLE_SIZE)),
628 nest 2 (text "Workaround: use nested tuples or define a data type")]
629
630 -- | Ensure that a constraint tuple has arity no larger than 'mAX_CTUPLE_SIZE'.
631 checkCTupSize :: Int -> TcM ()
632 checkCTupSize tup_size
633 | tup_size <= mAX_CTUPLE_SIZE
634 = return ()
635 | otherwise
636 = addErr $ TcRnUnknownMessage $ mkPlainError noHints $
637 hang (text "Constraint tuple arity too large:" <+> int tup_size
638 <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE))
639 2 (text "Instead, use a nested tuple")
640
641 {- *********************************************************************
642 * *
643 Generating code for HsExpanded
644 See Note [Handling overloaded and rebindable constructs]
645 * *
646 ********************************************************************* -}
647
648 wrapGenSpan :: a -> LocatedAn an a
649 -- Wrap something in a "generatedSrcSpan"
650 -- See Note [Rebindable syntax and HsExpansion]
651 wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
652
653 genHsApps :: Name -> [LHsExpr GhcRn] -> HsExpr GhcRn
654 genHsApps fun args = foldl genHsApp (genHsVar fun) args
655
656 genHsApp :: HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
657 genHsApp fun arg = HsApp noAnn (wrapGenSpan fun) arg
658
659 genLHsVar :: Name -> LHsExpr GhcRn
660 genLHsVar nm = wrapGenSpan $ genHsVar nm
661
662 genHsVar :: Name -> HsExpr GhcRn
663 genHsVar nm = HsVar noExtField $ wrapGenSpan nm
664
665 genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
666 genAppType expr = HsAppType noExtField (wrapGenSpan expr) . mkEmptyWildCardBndrs . wrapGenSpan
667
668 genHsIntegralLit :: IntegralLit -> LocatedAn an (HsExpr GhcRn)
669 genHsIntegralLit lit = wrapGenSpan $ HsLit noAnn (HsInt noExtField lit)
670
671 genHsTyLit :: FastString -> HsType GhcRn
672 genHsTyLit = HsTyLit noExtField . HsStrTy NoSourceText
673
674 {-
675 ************************************************************************
676 * *
677 \subsection{Contexts for renaming errors}
678 * *
679 ************************************************************************
680 -}
681
682 -- AZ:TODO: Change these all to be Name instead of RdrName.
683 -- Merge TcType.UserTypeContext in to it.
684 data HsDocContext
685 = TypeSigCtx SDoc
686 | StandaloneKindSigCtx SDoc
687 | PatCtx
688 | SpecInstSigCtx
689 | DefaultDeclCtx
690 | ForeignDeclCtx (LocatedN RdrName)
691 | DerivDeclCtx
692 | RuleCtx FastString
693 | TyDataCtx (LocatedN RdrName)
694 | TySynCtx (LocatedN RdrName)
695 | TyFamilyCtx (LocatedN RdrName)
696 | FamPatCtx (LocatedN RdrName) -- The patterns of a type/data family instance
697 | ConDeclCtx [LocatedN Name]
698 | ClassDeclCtx (LocatedN RdrName)
699 | ExprWithTySigCtx
700 | TypBrCtx
701 | HsTypeCtx
702 | HsTypePatCtx
703 | GHCiCtx
704 | SpliceTypeCtx (LHsType GhcPs)
705 | ClassInstanceCtx
706 | GenericCtx SDoc -- Maybe we want to use this more!
707
708 withHsDocContext :: HsDocContext -> SDoc -> SDoc
709 withHsDocContext ctxt doc = doc $$ inHsDocContext ctxt
710
711 inHsDocContext :: HsDocContext -> SDoc
712 inHsDocContext ctxt = text "In" <+> pprHsDocContext ctxt
713
714 pprHsDocContext :: HsDocContext -> SDoc
715 pprHsDocContext (GenericCtx doc) = doc
716 pprHsDocContext (TypeSigCtx doc) = text "the type signature for" <+> doc
717 pprHsDocContext (StandaloneKindSigCtx doc) = text "the standalone kind signature for" <+> doc
718 pprHsDocContext PatCtx = text "a pattern type-signature"
719 pprHsDocContext SpecInstSigCtx = text "a SPECIALISE instance pragma"
720 pprHsDocContext DefaultDeclCtx = text "a `default' declaration"
721 pprHsDocContext DerivDeclCtx = text "a deriving declaration"
722 pprHsDocContext (RuleCtx name) = text "the rewrite rule" <+> doubleQuotes (ftext name)
723 pprHsDocContext (TyDataCtx tycon) = text "the data type declaration for" <+> quotes (ppr tycon)
724 pprHsDocContext (FamPatCtx tycon) = text "a type pattern of family instance for" <+> quotes (ppr tycon)
725 pprHsDocContext (TySynCtx name) = text "the declaration for type synonym" <+> quotes (ppr name)
726 pprHsDocContext (TyFamilyCtx name) = text "the declaration for type family" <+> quotes (ppr name)
727 pprHsDocContext (ClassDeclCtx name) = text "the declaration for class" <+> quotes (ppr name)
728 pprHsDocContext ExprWithTySigCtx = text "an expression type signature"
729 pprHsDocContext TypBrCtx = text "a Template-Haskell quoted type"
730 pprHsDocContext HsTypeCtx = text "a type argument"
731 pprHsDocContext HsTypePatCtx = text "a type argument in a pattern"
732 pprHsDocContext GHCiCtx = text "GHCi input"
733 pprHsDocContext (SpliceTypeCtx hs_ty) = text "the spliced type" <+> quotes (ppr hs_ty)
734 pprHsDocContext ClassInstanceCtx = text "GHC.Tc.Gen.Splice.reifyInstances"
735
736 pprHsDocContext (ForeignDeclCtx name)
737 = text "the foreign declaration for" <+> quotes (ppr name)
738 pprHsDocContext (ConDeclCtx [name])
739 = text "the definition of data constructor" <+> quotes (ppr name)
740 pprHsDocContext (ConDeclCtx names)
741 = text "the definition of data constructors" <+> interpp'SP names