never executed always true always false
1
2 {-# LANGUAGE DataKinds #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE LambdaCase #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# LANGUAGE TypeFamilies #-}
7
8 {-
9 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
10
11 -}
12
13 module GHC.Rename.HsType (
14 -- Type related stuff
15 rnHsType, rnLHsType, rnLHsTypes, rnContext, rnMaybeContext,
16 rnHsKind, rnLHsKind, rnLHsTypeArgs,
17 rnHsSigType, rnHsWcType, rnHsPatSigTypeBindingVars,
18 HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType,
19 newTyVarNameRn,
20 rnConDeclFields,
21 lookupField,
22 rnLTyVar,
23
24 rnScaledLHsType,
25
26 -- Precence related stuff
27 NegationHandling(..),
28 mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
29 checkPrecMatch, checkSectionPrec,
30
31 -- Binding related stuff
32 bindHsOuterTyVarBndrs, bindHsForAllTelescope,
33 bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..),
34 rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars,
35 FreeKiTyVars, filterInScopeM,
36 extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
37 extractHsTysRdrTyVars, extractRdrKindSigVars,
38 extractConDeclGADTDetailsTyVars, extractDataDefnKindVars,
39 extractHsOuterTvBndrs, extractHsTyArgRdrKiTyVars,
40 nubL, nubN
41 ) where
42
43 import GHC.Prelude
44
45 import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType )
46
47 import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList )
48 import GHC.Driver.Session
49 import GHC.Hs
50 import GHC.Rename.Env
51 import GHC.Rename.Utils ( HsDocContext(..), inHsDocContext, withHsDocContext
52 , mapFvRn, pprHsDocContext, bindLocalNamesFV
53 , typeAppErr, newLocalBndrRn, checkDupRdrNamesN
54 , checkShadowedRdrNames )
55 import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn
56 , lookupTyFixityRn )
57 import GHC.Rename.Unbound ( notInScopeErr, WhereLooking(WL_LocalOnly) )
58 import GHC.Tc.Errors.Types
59 import GHC.Tc.Utils.Monad
60 import GHC.Types.Name.Reader
61 import GHC.Builtin.Names
62 import GHC.Types.Name
63 import GHC.Types.SrcLoc
64 import GHC.Types.Name.Set
65 import GHC.Types.FieldLabel
66 import GHC.Types.Error
67
68 import GHC.Utils.Misc
69 import GHC.Types.Fixity ( compareFixity, negateFixity
70 , Fixity(..), FixityDirection(..), LexicalFixity(..) )
71 import GHC.Types.Basic ( TypeOrKind(..) )
72 import GHC.Utils.Outputable
73 import GHC.Utils.Panic
74 import GHC.Utils.Panic.Plain
75 import GHC.Data.Maybe
76 import qualified GHC.LanguageExtensions as LangExt
77
78 import Data.List (sortBy, nubBy, partition)
79 import qualified Data.List.NonEmpty as NE
80 import Data.List.NonEmpty (NonEmpty(..))
81 import Control.Monad
82
83 {-
84 These type renamers are in a separate module, rather than in (say) GHC.Rename.Module,
85 to break several loops.
86
87 *********************************************************
88 * *
89 HsSigWcType and HsPatSigType (i.e with wildcards)
90 * *
91 *********************************************************
92 -}
93
94 data HsPatSigTypeScoping
95 = AlwaysBind
96 -- ^ Always bind any free tyvars of the given type, regardless of whether we
97 -- have a forall at the top.
98 --
99 -- For pattern type sigs, we /do/ want to bring those type
100 -- variables into scope, even if there's a forall at the top which usually
101 -- stops that happening, e.g:
102 --
103 -- > \ (x :: forall a. a -> b) -> e
104 --
105 -- Here we do bring 'b' into scope.
106 --
107 -- RULES can also use 'AlwaysBind', such as in the following example:
108 --
109 -- > {-# RULES \"f\" forall (x :: forall a. a -> b). f x = ... b ... #-}
110 --
111 -- This only applies to RULES that do not explicitly bind their type
112 -- variables. If a RULE explicitly quantifies its type variables, then
113 -- 'NeverBind' is used instead. See also
114 -- @Note [Pattern signature binders and scoping]@ in "GHC.Hs.Type".
115 | NeverBind
116 -- ^ Never bind any free tyvars. This is used for RULES that have both
117 -- explicit type and term variable binders, e.g.:
118 --
119 -- > {-# RULES \"const\" forall a. forall (x :: a) y. const x y = x #-}
120 --
121 -- The presence of the type variable binder @forall a.@ implies that the
122 -- free variables in the types of the term variable binders @x@ and @y@
123 -- are /not/ bound. In the example above, there are no such free variables,
124 -- but if the user had written @(y :: b)@ instead of @y@ in the term
125 -- variable binders, then @b@ would be rejected for being out of scope.
126 -- See also @Note [Pattern signature binders and scoping]@ in
127 -- "GHC.Hs.Type".
128
129 rnHsSigWcType :: HsDocContext
130 -> LHsSigWcType GhcPs
131 -> RnM (LHsSigWcType GhcRn, FreeVars)
132 rnHsSigWcType doc (HsWC { hswc_body =
133 sig_ty@(L loc (HsSig{sig_bndrs = outer_bndrs, sig_body = body_ty })) })
134 = do { free_vars <- filterInScopeM (extract_lhs_sig_ty sig_ty)
135 ; (nwc_rdrs', imp_tv_nms) <- partition_nwcs free_vars
136 ; let nwc_rdrs = nubL nwc_rdrs'
137 ; bindHsOuterTyVarBndrs doc Nothing imp_tv_nms outer_bndrs $ \outer_bndrs' ->
138 do { (wcs, body_ty', fvs) <- rnWcBody doc nwc_rdrs body_ty
139 ; pure ( HsWC { hswc_ext = wcs, hswc_body = L loc $
140 HsSig { sig_ext = noExtField
141 , sig_bndrs = outer_bndrs', sig_body = body_ty' }}
142 , fvs) } }
143
144 rnHsPatSigType :: HsPatSigTypeScoping
145 -> HsDocContext
146 -> HsPatSigType GhcPs
147 -> (HsPatSigType GhcRn -> RnM (a, FreeVars))
148 -> RnM (a, FreeVars)
149 -- Used for
150 -- - Pattern type signatures, which are only allowed with ScopedTypeVariables
151 -- - Signatures on binders in a RULE, which are allowed even if
152 -- ScopedTypeVariables isn't enabled
153 -- Wildcards are allowed
154 --
155 -- See Note [Pattern signature binders and scoping] in GHC.Hs.Type
156 rnHsPatSigType scoping ctx sig_ty thing_inside
157 = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables
158 ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty)
159 ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty)
160 ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars
161 ; let nwc_rdrs = nubN nwc_rdrs'
162 implicit_bndrs = case scoping of
163 AlwaysBind -> tv_rdrs
164 NeverBind -> []
165 ; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs ->
166 do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty
167 ; let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs }
168 sig_ty' = HsPS { hsps_ext = sig_names, hsps_body = pat_sig_ty' }
169 ; (res, fvs2) <- thing_inside sig_ty'
170 ; return (res, fvs1 `plusFV` fvs2) } }
171 where
172 pat_sig_ty = hsPatSigType sig_ty
173
174 rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
175 rnHsWcType ctxt (HsWC { hswc_body = hs_ty })
176 = do { free_vars <- filterInScopeM (extractHsTyRdrTyVars hs_ty)
177 ; (nwc_rdrs', _) <- partition_nwcs free_vars
178 ; let nwc_rdrs = nubL nwc_rdrs'
179 ; (wcs, hs_ty', fvs) <- rnWcBody ctxt nwc_rdrs hs_ty
180 ; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = hs_ty' }
181 ; return (sig_ty', fvs) }
182
183 -- Similar to rnHsWcType, but rather than requiring free variables in the type to
184 -- already be in scope, we are going to require them not to be in scope,
185 -- and we bind them.
186 rnHsPatSigTypeBindingVars :: HsDocContext
187 -> HsPatSigType GhcPs
188 -> (HsPatSigType GhcRn -> RnM (r, FreeVars))
189 -> RnM (r, FreeVars)
190 rnHsPatSigTypeBindingVars ctxt sigType thing_inside = case sigType of
191 (HsPS { hsps_body = hs_ty }) -> do
192 rdr_env <- getLocalRdrEnv
193 let (varsInScope, varsNotInScope) =
194 partition (inScope rdr_env . unLoc) (extractHsTyRdrTyVars hs_ty)
195 -- TODO: Resolve and remove this comment.
196 -- This next bit is in some contention. The original proposal #126
197 -- (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0126-type-applications-in-patterns.rst)
198 -- says that in-scope variables are fine here: don't bind them, just use
199 -- the existing vars, like in type signatures. An amendment #291
200 -- (https://github.com/ghc-proposals/ghc-proposals/pull/291) says that the
201 -- use of an in-scope variable should *shadow* an in-scope tyvar, like in
202 -- terms. In an effort to make forward progress, the current implementation
203 -- just rejects any use of an in-scope variable, meaning GHC will accept
204 -- a subset of programs common to both variants. If this comment still exists
205 -- in mid-to-late 2021 or thereafter, we have done a poor job on following
206 -- up on this point.
207 -- Example:
208 -- f :: forall a. ...
209 -- f (MkT @a ...) = ...
210 -- Should the inner `a` refer to the outer one? shadow it? We are, as yet, undecided,
211 -- so we currently reject.
212 when (not (null varsInScope)) $
213 addErr $ TcRnUnknownMessage $ mkPlainError noHints $
214 vcat
215 [ text "Type variable" <> plural varsInScope
216 <+> hcat (punctuate (text ",") (map (quotes . ppr) varsInScope))
217 <+> isOrAre varsInScope
218 <+> text "already in scope."
219 , text "Type applications in patterns must bind fresh variables, without shadowing."
220 ]
221 (wcVars, ibVars) <- partition_nwcs varsNotInScope
222 rnImplicitTvBndrs ctxt Nothing ibVars $ \ ibVars' -> do
223 (wcVars', hs_ty', fvs) <- rnWcBody ctxt wcVars hs_ty
224 let sig_ty = HsPS
225 { hsps_body = hs_ty'
226 , hsps_ext = HsPSRn
227 { hsps_nwcs = wcVars'
228 , hsps_imp_tvs = ibVars'
229 }
230 }
231 (res, fvs') <- thing_inside sig_ty
232 return (res, fvs `plusFV` fvs')
233
234 rnWcBody :: HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs
235 -> RnM ([Name], LHsType GhcRn, FreeVars)
236 rnWcBody ctxt nwc_rdrs hs_ty
237 = do { nwcs <- mapM newLocalBndrRn nwc_rdrs
238 ; let env = RTKE { rtke_level = TypeLevel
239 , rtke_what = RnTypeBody
240 , rtke_nwcs = mkNameSet nwcs
241 , rtke_ctxt = ctxt }
242 ; (hs_ty', fvs) <- bindLocalNamesFV nwcs $
243 rn_lty env hs_ty
244 ; return (nwcs, hs_ty', fvs) }
245 where
246 rn_lty env (L loc hs_ty)
247 = setSrcSpanA loc $
248 do { (hs_ty', fvs) <- rn_ty env hs_ty
249 ; return (L loc hs_ty', fvs) }
250
251 rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
252 -- A lot of faff just to allow the extra-constraints wildcard to appear
253 rn_ty env (HsForAllTy { hst_tele = tele, hst_body = hs_body })
254 = bindHsForAllTelescope (rtke_ctxt env) tele $ \ tele' ->
255 do { (hs_body', fvs) <- rn_lty env hs_body
256 ; return (HsForAllTy { hst_xforall = noExtField
257 , hst_tele = tele', hst_body = hs_body' }
258 , fvs) }
259
260 rn_ty env (HsQualTy { hst_ctxt = L cx hs_ctxt
261 , hst_body = hs_ty })
262 | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt
263 , L lx (HsWildCardTy _) <- ignoreParens hs_ctxt_last
264 = do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1
265 ; setSrcSpanA lx $ checkExtraConstraintWildCard env hs_ctxt1
266 ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy noExtField)]
267 ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
268 ; return (HsQualTy { hst_xqual = noExtField
269 , hst_ctxt = L cx hs_ctxt'
270 , hst_body = hs_ty' }
271 , fvs1 `plusFV` fvs2) }
272
273 | otherwise
274 = do { (hs_ctxt', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt
275 ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
276 ; return (HsQualTy { hst_xqual = noExtField
277 , hst_ctxt = L cx hs_ctxt'
278 , hst_body = hs_ty' }
279 , fvs1 `plusFV` fvs2) }
280
281
282 rn_ty env hs_ty = rnHsTyKi env hs_ty
283
284 rn_top_constraint env = rnLHsTyKi (env { rtke_what = RnTopConstraint })
285
286
287 checkExtraConstraintWildCard :: RnTyKiEnv -> HsContext GhcPs -> RnM ()
288 -- Rename the extra-constraint spot in a type signature
289 -- (blah, _) => type
290 -- Check that extra-constraints are allowed at all, and
291 -- if so that it's an anonymous wildcard
292 checkExtraConstraintWildCard env hs_ctxt
293 = checkWildCard env mb_bad
294 where
295 mb_bad | not (extraConstraintWildCardsAllowed env)
296 = Just base_msg
297 -- Currently, we do not allow wildcards in their full glory in
298 -- standalone deriving declarations. We only allow a single
299 -- extra-constraints wildcard à la:
300 --
301 -- deriving instance _ => Eq (Foo a)
302 --
303 -- i.e., we don't support things like
304 --
305 -- deriving instance (Eq a, _) => Eq (Foo a)
306 | DerivDeclCtx {} <- rtke_ctxt env
307 , not (null hs_ctxt)
308 = Just deriv_decl_msg
309 | otherwise
310 = Nothing
311
312 base_msg = text "Extra-constraint wildcard" <+> quotes pprAnonWildCard
313 <+> text "not allowed"
314
315 deriv_decl_msg
316 = hang base_msg
317 2 (vcat [ text "except as the sole constraint"
318 , nest 2 (text "e.g., deriving instance _ => Eq (Foo a)") ])
319
320 extraConstraintWildCardsAllowed :: RnTyKiEnv -> Bool
321 extraConstraintWildCardsAllowed env
322 = case rtke_ctxt env of
323 TypeSigCtx {} -> True
324 ExprWithTySigCtx {} -> True
325 DerivDeclCtx {} -> True
326 StandaloneKindSigCtx {} -> False -- See Note [Wildcards in standalone kind signatures] in "GHC.Hs.Decls"
327 _ -> False
328
329 -- | When the NamedWildCards extension is enabled, partition_nwcs
330 -- removes type variables that start with an underscore from the
331 -- FreeKiTyVars in the argument and returns them in a separate list.
332 -- When the extension is disabled, the function returns the argument
333 -- and empty list. See Note [Renaming named wild cards]
334 partition_nwcs :: FreeKiTyVars -> RnM ([LocatedN RdrName], FreeKiTyVars)
335 partition_nwcs free_vars
336 = do { wildcards_enabled <- xoptM LangExt.NamedWildCards
337 ; return $
338 if wildcards_enabled
339 then partition is_wildcard free_vars
340 else ([], free_vars) }
341 where
342 is_wildcard :: LocatedN RdrName -> Bool
343 is_wildcard rdr = startsWithUnderscore (rdrNameOcc (unLoc rdr))
344
345 {- Note [Renaming named wild cards]
346 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
347 Identifiers starting with an underscore are always parsed as type variables.
348 It is only here in the renamer that we give the special treatment.
349 See Note [The wildcard story for types] in GHC.Hs.Type.
350
351 It's easy! When we collect the implicitly bound type variables, ready
352 to bring them into scope, and NamedWildCards is on, we partition the
353 variables into the ones that start with an underscore (the named
354 wildcards) and the rest. Then we just add them to the hswc_wcs field
355 of the HsWildCardBndrs structure, and we are done.
356
357
358 *********************************************************
359 * *
360 HsSigType (i.e. no wildcards)
361 * *
362 ****************************************************** -}
363
364 rnHsSigType :: HsDocContext
365 -> TypeOrKind
366 -> LHsSigType GhcPs
367 -> RnM (LHsSigType GhcRn, FreeVars)
368 -- Used for source-language type signatures
369 -- that cannot have wildcards
370 rnHsSigType ctx level
371 (L loc sig_ty@(HsSig { sig_bndrs = outer_bndrs, sig_body = body }))
372 = setSrcSpanA loc $
373 do { traceRn "rnHsSigType" (ppr sig_ty)
374 ; case outer_bndrs of
375 HsOuterExplicit{} -> checkPolyKinds env sig_ty
376 HsOuterImplicit{} -> pure ()
377 ; imp_vars <- filterInScopeM $ extractHsTyRdrTyVars body
378 ; bindHsOuterTyVarBndrs ctx Nothing imp_vars outer_bndrs $ \outer_bndrs' ->
379 do { (body', fvs) <- rnLHsTyKi env body
380
381 ; return ( L loc $ HsSig { sig_ext = noExtField
382 , sig_bndrs = outer_bndrs', sig_body = body' }
383 , fvs ) } }
384 where
385 env = mkTyKiEnv ctx level RnTypeBody
386
387 -- | Create new renamed type variables corresponding to source-level ones.
388 -- Duplicates are permitted, but will be removed. This is intended especially for
389 -- the case of handling the implicitly bound free variables of a type signature.
390 rnImplicitTvOccs :: Maybe assoc
391 -- ^ @'Just' _@ => an associated type decl
392 -> FreeKiTyVars
393 -- ^ Surface-syntax free vars that we will implicitly bind.
394 -- May have duplicates, which are removed here.
395 -> ([Name] -> RnM (a, FreeVars))
396 -> RnM (a, FreeVars)
397 rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside
398 = do { let implicit_vs = nubN implicit_vs_with_dups
399
400 ; traceRn "rnImplicitTvOccs" $
401 vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ]
402
403 -- Use the currently set SrcSpan as the new source location for each Name.
404 -- See Note [Source locations for implicitly bound type variables].
405 ; loc <- getSrcSpanM
406 ; let loc' = noAnnSrcSpan loc
407 ; vars <- mapM (newTyVarNameRn mb_assoc . L loc' . unLoc) implicit_vs
408
409 ; bindLocalNamesFV vars $
410 thing_inside vars }
411
412 {-
413 Note [Source locations for implicitly bound type variables]
414 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
415 When bringing implicitly bound type variables into scope (in rnImplicitTvOccs),
416 we do something peculiar: we drop the original SrcSpan attached to each
417 variable and replace it with the currently set SrcSpan. Moreover, this new
418 SrcSpan is usually /less/ precise than the original one, and that's OK. To see
419 why this is done, consider the following example:
420
421 f :: a -> b -> a
422
423 Suppose that a warning or error message needs to point to the SrcSpans of the
424 binding sites for `a` and `b`. But where /are/ they bound, anyway? Technically,
425 they're bound by an unwritten `forall` at the front of the type signature, but
426 there is no SrcSpan for that. We could point to the first occurrence of `a` as
427 the binding site for `a`, but that would make the first occurrence of `a`
428 special. Moreover, we don't want IDEs to confuse binding sites and occurrences.
429
430 As a result, we make the `SrcSpan`s for `a` and `b` span the entirety of the
431 type signature, since the type signature implicitly carries their binding
432 sites. This is less precise, but more accurate.
433 -}
434
435 -- | Create fresh type variables for binders, disallowing multiple occurrences of the same variable. Similar to `rnImplicitTvOccs` except that duplicate occurrences will
436 -- result in an error, and the source locations of the variables are not adjusted, as these variable occurrences are themselves the binding sites for the type variables,
437 -- rather than the variables being implicitly bound by a signature.
438 rnImplicitTvBndrs :: HsDocContext
439 -> Maybe assoc
440 -- ^ @'Just' _@ => an associated type decl
441 -> FreeKiTyVars
442 -- ^ Surface-syntax free vars that we will implicitly bind.
443 -- Duplicate variables will cause a compile-time error regarding repeated bindings.
444 -> ([Name] -> RnM (a, FreeVars))
445 -> RnM (a, FreeVars)
446 rnImplicitTvBndrs ctx mb_assoc implicit_vs_with_dups thing_inside
447 = do { implicit_vs <- forM (NE.groupBy eqLocated $ sortBy cmpLocated $ implicit_vs_with_dups) $ \case
448 (x :| []) -> return x
449 (x :| _) -> do
450 let msg = TcRnUnknownMessage $ mkPlainError noHints $
451 text "Variable" <+> text "`" <> ppr x <> text "'" <+> text "would be bound multiple times by" <+> pprHsDocContext ctx <> text "."
452 addErr msg
453 return x
454
455 ; traceRn "rnImplicitTvBndrs" $
456 vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ]
457
458 ; vars <- mapM (newTyVarNameRn mb_assoc) implicit_vs
459
460 ; bindLocalNamesFV vars $
461 thing_inside vars }
462
463 {- ******************************************************
464 * *
465 LHsType and HsType
466 * *
467 ****************************************************** -}
468
469 {-
470 rnHsType is here because we call it from loadInstDecl, and I didn't
471 want a gratuitous knot.
472
473 Note [HsQualTy in kinds]
474 ~~~~~~~~~~~~~~~~~~~~~~
475 I was wondering whether HsQualTy could occur only at TypeLevel. But no,
476 we can have a qualified type in a kind too. Here is an example:
477
478 type family F a where
479 F Bool = Nat
480 F Nat = Type
481
482 type family G a where
483 G Type = Type -> Type
484 G () = Nat
485
486 data X :: forall k1 k2. (F k1 ~ G k2) => k1 -> k2 -> Type where
487 MkX :: X 'True '()
488
489 See that k1 becomes Bool and k2 becomes (), so the equality is
490 satisfied. If I write MkX :: X 'True 'False, compilation fails with a
491 suitable message:
492
493 MkX :: X 'True '()
494 • Couldn't match kind ‘G Bool’ with ‘Nat’
495 Expected kind: G Bool
496 Actual kind: F Bool
497
498 However: in a kind, the constraints in the HsQualTy must all be
499 equalities; or at least, any kinds with a class constraint are
500 uninhabited. See Note [Constraints in kinds] in GHC.Core.TyCo.Rep.
501 -}
502
503 data RnTyKiEnv
504 = RTKE { rtke_ctxt :: HsDocContext
505 , rtke_level :: TypeOrKind -- Am I renaming a type or a kind?
506 , rtke_what :: RnTyKiWhat -- And within that what am I renaming?
507 , rtke_nwcs :: NameSet -- These are the in-scope named wildcards
508 }
509
510 data RnTyKiWhat = RnTypeBody
511 | RnTopConstraint -- Top-level context of HsSigWcTypes
512 | RnConstraint -- All other constraints
513
514 instance Outputable RnTyKiEnv where
515 ppr (RTKE { rtke_level = lev, rtke_what = what
516 , rtke_nwcs = wcs, rtke_ctxt = ctxt })
517 = text "RTKE"
518 <+> braces (sep [ ppr lev, ppr what, ppr wcs
519 , pprHsDocContext ctxt ])
520
521 instance Outputable RnTyKiWhat where
522 ppr RnTypeBody = text "RnTypeBody"
523 ppr RnTopConstraint = text "RnTopConstraint"
524 ppr RnConstraint = text "RnConstraint"
525
526 mkTyKiEnv :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
527 mkTyKiEnv cxt level what
528 = RTKE { rtke_level = level, rtke_nwcs = emptyNameSet
529 , rtke_what = what, rtke_ctxt = cxt }
530
531 isRnKindLevel :: RnTyKiEnv -> Bool
532 isRnKindLevel (RTKE { rtke_level = KindLevel }) = True
533 isRnKindLevel _ = False
534
535 --------------
536 rnLHsType :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
537 rnLHsType ctxt ty = rnLHsTyKi (mkTyKiEnv ctxt TypeLevel RnTypeBody) ty
538
539 rnLHsTypes :: HsDocContext -> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
540 rnLHsTypes doc tys = mapFvRn (rnLHsType doc) tys
541
542 rnScaledLHsType :: HsDocContext -> HsScaled GhcPs (LHsType GhcPs)
543 -> RnM (HsScaled GhcRn (LHsType GhcRn), FreeVars)
544 rnScaledLHsType doc (HsScaled w ty) = do
545 (w' , fvs_w) <- rnHsArrow (mkTyKiEnv doc TypeLevel RnTypeBody) w
546 (ty', fvs) <- rnLHsType doc ty
547 return (HsScaled w' ty', fvs `plusFV` fvs_w)
548
549
550 rnHsType :: HsDocContext -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
551 rnHsType ctxt ty = rnHsTyKi (mkTyKiEnv ctxt TypeLevel RnTypeBody) ty
552
553 rnLHsKind :: HsDocContext -> LHsKind GhcPs -> RnM (LHsKind GhcRn, FreeVars)
554 rnLHsKind ctxt kind = rnLHsTyKi (mkTyKiEnv ctxt KindLevel RnTypeBody) kind
555
556 rnHsKind :: HsDocContext -> HsKind GhcPs -> RnM (HsKind GhcRn, FreeVars)
557 rnHsKind ctxt kind = rnHsTyKi (mkTyKiEnv ctxt KindLevel RnTypeBody) kind
558
559 -- renaming a type only, not a kind
560 rnLHsTypeArg :: HsDocContext -> LHsTypeArg GhcPs
561 -> RnM (LHsTypeArg GhcRn, FreeVars)
562 rnLHsTypeArg ctxt (HsValArg ty)
563 = do { (tys_rn, fvs) <- rnLHsType ctxt ty
564 ; return (HsValArg tys_rn, fvs) }
565 rnLHsTypeArg ctxt (HsTypeArg l ki)
566 = do { (kis_rn, fvs) <- rnLHsKind ctxt ki
567 ; return (HsTypeArg l kis_rn, fvs) }
568 rnLHsTypeArg _ (HsArgPar sp)
569 = return (HsArgPar sp, emptyFVs)
570
571 rnLHsTypeArgs :: HsDocContext -> [LHsTypeArg GhcPs]
572 -> RnM ([LHsTypeArg GhcRn], FreeVars)
573 rnLHsTypeArgs doc args = mapFvRn (rnLHsTypeArg doc) args
574
575 --------------
576 rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs
577 -> RnM (LHsContext GhcRn, FreeVars)
578 rnTyKiContext env (L loc cxt)
579 = do { traceRn "rncontext" (ppr cxt)
580 ; let env' = env { rtke_what = RnConstraint }
581 ; (cxt', fvs) <- mapFvRn (rnLHsTyKi env') cxt
582 ; return (L loc cxt', fvs) }
583
584 rnContext :: HsDocContext -> LHsContext GhcPs
585 -> RnM (LHsContext GhcRn, FreeVars)
586 rnContext doc theta = rnTyKiContext (mkTyKiEnv doc TypeLevel RnConstraint) theta
587
588 rnMaybeContext :: HsDocContext -> Maybe (LHsContext GhcPs)
589 -> RnM (Maybe (LHsContext GhcRn), FreeVars)
590 rnMaybeContext _ Nothing = return (Nothing, emptyFVs)
591 rnMaybeContext doc (Just theta)
592 = do { (theta', fvs) <- rnContext doc theta
593 ; return (Just theta', fvs)
594 }
595
596
597 --------------
598 rnLHsTyKi :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
599 rnLHsTyKi env (L loc ty)
600 = setSrcSpanA loc $
601 do { (ty', fvs) <- rnHsTyKi env ty
602 ; return (L loc ty', fvs) }
603
604 rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
605
606 rnHsTyKi env ty@(HsForAllTy { hst_tele = tele, hst_body = tau })
607 = do { checkPolyKinds env ty
608 ; bindHsForAllTelescope (rtke_ctxt env) tele $ \ tele' ->
609 do { (tau', fvs) <- rnLHsTyKi env tau
610 ; return ( HsForAllTy { hst_xforall = noExtField
611 , hst_tele = tele' , hst_body = tau' }
612 , fvs) } }
613
614 rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau })
615 = do { data_kinds <- xoptM LangExt.DataKinds -- See Note [HsQualTy in kinds]
616 ; when (not data_kinds && isRnKindLevel env)
617 (addErr (dataKindsErr env ty))
618 ; (ctxt', fvs1) <- rnTyKiContext env lctxt
619 ; (tau', fvs2) <- rnLHsTyKi env tau
620 ; return (HsQualTy { hst_xqual = noExtField, hst_ctxt = ctxt'
621 , hst_body = tau' }
622 , fvs1 `plusFV` fvs2) }
623
624 rnHsTyKi env (HsTyVar _ ip (L loc rdr_name))
625 = do { when (isRnKindLevel env && isRdrTyVar rdr_name) $
626 unlessXOptM LangExt.PolyKinds $ addErr $ TcRnUnknownMessage $ mkPlainError noHints $
627 withHsDocContext (rtke_ctxt env) $
628 vcat [ text "Unexpected kind variable" <+> quotes (ppr rdr_name)
629 , text "Perhaps you intended to use PolyKinds" ]
630 -- Any type variable at the kind level is illegal without the use
631 -- of PolyKinds (see #14710)
632 ; name <- rnTyVar env rdr_name
633 ; return (HsTyVar noAnn ip (L loc name), unitFV name) }
634
635 rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2)
636 = setSrcSpan (getLocA l_op) $
637 do { (l_op', fvs1) <- rnHsTyOp env ty l_op
638 ; fix <- lookupTyFixityRn l_op'
639 ; (ty1', fvs2) <- rnLHsTyKi env ty1
640 ; (ty2', fvs3) <- rnLHsTyKi env ty2
641 ; res_ty <- mkHsOpTyRn l_op' fix ty1' ty2'
642 ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) }
643
644 rnHsTyKi env (HsParTy _ ty)
645 = do { (ty', fvs) <- rnLHsTyKi env ty
646 ; return (HsParTy noAnn ty', fvs) }
647
648 rnHsTyKi env (HsBangTy x b ty)
649 = do { (ty', fvs) <- rnLHsTyKi env ty
650 ; return (HsBangTy x b ty', fvs) }
651
652 rnHsTyKi env ty@(HsRecTy _ flds)
653 = do { let ctxt = rtke_ctxt env
654 ; fls <- get_fields ctxt
655 ; (flds', fvs) <- rnConDeclFields ctxt fls flds
656 ; return (HsRecTy noExtField flds', fvs) }
657 where
658 get_fields (ConDeclCtx names)
659 = concatMapM (lookupConstructorFields . unLoc) names
660 get_fields _
661 = do { addErr $ TcRnUnknownMessage $ mkPlainError noHints $
662 (hang (text "Record syntax is illegal here:") 2 (ppr ty))
663 ; return [] }
664
665 rnHsTyKi env (HsFunTy u mult ty1 ty2)
666 = do { (ty1', fvs1) <- rnLHsTyKi env ty1
667 ; (ty2', fvs2) <- rnLHsTyKi env ty2
668 ; (mult', w_fvs) <- rnHsArrow env mult
669 ; return (HsFunTy u mult' ty1' ty2'
670 , plusFVs [fvs1, fvs2, w_fvs]) }
671
672 rnHsTyKi env listTy@(HsListTy x ty)
673 = do { data_kinds <- xoptM LangExt.DataKinds
674 ; when (not data_kinds && isRnKindLevel env)
675 (addErr (dataKindsErr env listTy))
676 ; (ty', fvs) <- rnLHsTyKi env ty
677 ; return (HsListTy x ty', fvs) }
678
679 rnHsTyKi env (HsKindSig x ty k)
680 = do { kind_sigs_ok <- xoptM LangExt.KindSignatures
681 ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty)
682 ; (ty', lhs_fvs) <- rnLHsTyKi env ty
683 ; (k', sig_fvs) <- rnLHsTyKi (env { rtke_level = KindLevel }) k
684 ; return (HsKindSig x ty' k', lhs_fvs `plusFV` sig_fvs) }
685
686 -- Unboxed tuples are allowed to have poly-typed arguments. These
687 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
688 rnHsTyKi env tupleTy@(HsTupleTy x tup_con tys)
689 = do { data_kinds <- xoptM LangExt.DataKinds
690 ; when (not data_kinds && isRnKindLevel env)
691 (addErr (dataKindsErr env tupleTy))
692 ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
693 ; return (HsTupleTy x tup_con tys', fvs) }
694
695 rnHsTyKi env sumTy@(HsSumTy x tys)
696 = do { data_kinds <- xoptM LangExt.DataKinds
697 ; when (not data_kinds && isRnKindLevel env)
698 (addErr (dataKindsErr env sumTy))
699 ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
700 ; return (HsSumTy x tys', fvs) }
701
702 -- Ensure that a type-level integer is nonnegative (#8306, #8412)
703 rnHsTyKi env tyLit@(HsTyLit _ t)
704 = do { data_kinds <- xoptM LangExt.DataKinds
705 ; unless data_kinds (addErr (dataKindsErr env tyLit))
706 ; when (negLit t) (addErr negLitErr)
707 ; return (HsTyLit noExtField t, emptyFVs) }
708 where
709 negLit (HsStrTy _ _) = False
710 negLit (HsNumTy _ i) = i < 0
711 negLit (HsCharTy _ _) = False
712 negLitErr :: TcRnMessage
713 negLitErr = TcRnUnknownMessage $ mkPlainError noHints $
714 text "Illegal literal in type (type literals must not be negative):" <+> ppr tyLit
715
716 rnHsTyKi env (HsAppTy _ ty1 ty2)
717 = do { (ty1', fvs1) <- rnLHsTyKi env ty1
718 ; (ty2', fvs2) <- rnLHsTyKi env ty2
719 ; return (HsAppTy noExtField ty1' ty2', fvs1 `plusFV` fvs2) }
720
721 rnHsTyKi env (HsAppKindTy l ty k)
722 = do { kind_app <- xoptM LangExt.TypeApplications
723 ; unless kind_app (addErr (typeAppErr "kind" k))
724 ; (ty', fvs1) <- rnLHsTyKi env ty
725 ; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k
726 ; return (HsAppKindTy l ty' k', fvs1 `plusFV` fvs2) }
727
728 rnHsTyKi env t@(HsIParamTy x n ty)
729 = do { notInKinds env t
730 ; (ty', fvs) <- rnLHsTyKi env ty
731 ; return (HsIParamTy x n ty', fvs) }
732
733 rnHsTyKi _ (HsStarTy _ isUni)
734 = return (HsStarTy noExtField isUni, emptyFVs)
735
736 rnHsTyKi _ (HsSpliceTy _ sp)
737 = rnSpliceType sp
738
739 rnHsTyKi env (HsDocTy x ty haddock_doc)
740 = do { (ty', fvs) <- rnLHsTyKi env ty
741 ; return (HsDocTy x ty' haddock_doc, fvs) }
742
743 -- See Note [Renaming HsCoreTys]
744 rnHsTyKi env (XHsType ty)
745 = do mapM_ (check_in_scope . nameRdrName) fvs_list
746 return (XHsType ty, fvs)
747 where
748 fvs_list = map getName $ tyCoVarsOfTypeList ty
749 fvs = mkFVs fvs_list
750
751 check_in_scope :: RdrName -> RnM ()
752 check_in_scope rdr_name = do
753 mb_name <- lookupLocalOccRn_maybe rdr_name
754 when (isNothing mb_name) $
755 addErr $ TcRnUnknownMessage $ mkPlainError noHints $
756 withHsDocContext (rtke_ctxt env) $
757 notInScopeErr WL_LocalOnly rdr_name
758
759 rnHsTyKi env ty@(HsExplicitListTy _ ip tys)
760 = do { data_kinds <- xoptM LangExt.DataKinds
761 ; unless data_kinds (addErr (dataKindsErr env ty))
762 ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
763 ; return (HsExplicitListTy noExtField ip tys', fvs) }
764
765 rnHsTyKi env ty@(HsExplicitTupleTy _ tys)
766 = do { data_kinds <- xoptM LangExt.DataKinds
767 ; unless data_kinds (addErr (dataKindsErr env ty))
768 ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
769 ; return (HsExplicitTupleTy noExtField tys', fvs) }
770
771 rnHsTyKi env (HsWildCardTy _)
772 = do { checkAnonWildCard env
773 ; return (HsWildCardTy noExtField, emptyFVs) }
774
775 rnHsArrow :: RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars)
776 rnHsArrow _env (HsUnrestrictedArrow arr) = return (HsUnrestrictedArrow arr, emptyFVs)
777 rnHsArrow _env (HsLinearArrow (HsPct1 pct1 arr)) = return (HsLinearArrow (HsPct1 pct1 arr), emptyFVs)
778 rnHsArrow _env (HsLinearArrow (HsLolly arr)) = return (HsLinearArrow (HsLolly arr), emptyFVs)
779 rnHsArrow env (HsExplicitMult pct p arr)
780 = (\(mult, fvs) -> (HsExplicitMult pct mult arr, fvs)) <$> rnLHsTyKi env p
781
782 {-
783 Note [Renaming HsCoreTys]
784 ~~~~~~~~~~~~~~~~~~~~~~~~~
785 HsCoreTy is an escape hatch that allows embedding Core Types in HsTypes.
786 As such, there's not much to be done in order to rename an HsCoreTy,
787 since it's already been renamed to some extent. However, in an attempt to
788 detect ill-formed HsCoreTys, the renamer checks to see if all free type
789 variables in an HsCoreTy are in scope. To see why this can matter, consider
790 this example from #18914:
791
792 type T f = forall a. f a
793
794 class C f where
795 m :: T f
796
797 newtype N f a = MkN (f a)
798 deriving C
799
800 Because of #18914, a previous GHC would generate the following code:
801
802 instance C f => C (N f) where
803 m :: T (N f)
804 m = coerce @(f a) -- The type within @(...) is an HsCoreTy
805 @(N f a) -- So is this
806 (m @f)
807
808 There are two HsCoreTys in play—(f a) and (N f a)—both of which have
809 `f` and `a` as free type variables. The `f` is in scope from the instance head,
810 but `a` is completely unbound, which is what led to #18914. To avoid this sort
811 of mistake going forward, the renamer will now detect that `a` is unbound and
812 throw an error accordingly.
813 -}
814
815 --------------
816 rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name
817 rnTyVar env rdr_name
818 = do { name <- lookupTypeOccRn rdr_name
819 ; checkNamedWildCard env name
820 ; return name }
821
822 rnLTyVar :: LocatedN RdrName -> RnM (LocatedN Name)
823 -- Called externally; does not deal with wildcards
824 rnLTyVar (L loc rdr_name)
825 = do { tyvar <- lookupTypeOccRn rdr_name
826 ; return (L loc tyvar) }
827
828 --------------
829 rnHsTyOp :: Outputable a
830 => RnTyKiEnv -> a -> LocatedN RdrName
831 -> RnM (LocatedN Name, FreeVars)
832 rnHsTyOp env overall_ty (L loc op)
833 = do { ops_ok <- xoptM LangExt.TypeOperators
834 ; op' <- rnTyVar env op
835 ; unless (ops_ok || op' `hasKey` eqTyConKey) $
836 addErr $ TcRnUnknownMessage $ mkPlainError noHints (opTyErr op overall_ty)
837 ; let l_op' = L loc op'
838 ; return (l_op', unitFV op') }
839
840 --------------
841 notAllowed :: SDoc -> SDoc
842 notAllowed doc
843 = text "Wildcard" <+> quotes doc <+> text "not allowed"
844
845 checkWildCard :: RnTyKiEnv -> Maybe SDoc -> RnM ()
846 checkWildCard env (Just doc)
847 = addErr $ TcRnUnknownMessage $ mkPlainError noHints $
848 vcat [doc, nest 2 (text "in" <+> pprHsDocContext (rtke_ctxt env))]
849 checkWildCard _ Nothing
850 = return ()
851
852 checkAnonWildCard :: RnTyKiEnv -> RnM ()
853 -- Report an error if an anonymous wildcard is illegal here
854 checkAnonWildCard env
855 = checkWildCard env mb_bad
856 where
857 mb_bad :: Maybe SDoc
858 mb_bad | not (wildCardsAllowed env)
859 = Just (notAllowed pprAnonWildCard)
860 | otherwise
861 = case rtke_what env of
862 RnTypeBody -> Nothing
863 RnTopConstraint -> Just constraint_msg
864 RnConstraint -> Just constraint_msg
865
866 constraint_msg = hang
867 (notAllowed pprAnonWildCard <+> text "in a constraint")
868 2 hint_msg
869 hint_msg = vcat [ text "except as the last top-level constraint of a type signature"
870 , nest 2 (text "e.g f :: (Eq a, _) => blah") ]
871
872 checkNamedWildCard :: RnTyKiEnv -> Name -> RnM ()
873 -- Report an error if a named wildcard is illegal here
874 checkNamedWildCard env name
875 = checkWildCard env mb_bad
876 where
877 mb_bad | not (name `elemNameSet` rtke_nwcs env)
878 = Nothing -- Not a wildcard
879 | not (wildCardsAllowed env)
880 = Just (notAllowed (ppr name))
881 | otherwise
882 = case rtke_what env of
883 RnTypeBody -> Nothing -- Allowed
884 RnTopConstraint -> Nothing -- Allowed; e.g.
885 -- f :: (Eq _a) => _a -> Int
886 -- g :: (_a, _b) => T _a _b -> Int
887 -- The named tyvars get filled in from elsewhere
888 RnConstraint -> Just constraint_msg
889 constraint_msg = notAllowed (ppr name) <+> text "in a constraint"
890
891 wildCardsAllowed :: RnTyKiEnv -> Bool
892 -- ^ In what contexts are wildcards permitted
893 wildCardsAllowed env
894 = case rtke_ctxt env of
895 TypeSigCtx {} -> True
896 TypBrCtx {} -> True -- Template Haskell quoted type
897 SpliceTypeCtx {} -> True -- Result of a Template Haskell splice
898 ExprWithTySigCtx {} -> True
899 PatCtx {} -> True
900 RuleCtx {} -> True
901 FamPatCtx {} -> True -- Not named wildcards though
902 GHCiCtx {} -> True
903 HsTypeCtx {} -> True
904 StandaloneKindSigCtx {} -> False -- See Note [Wildcards in standalone kind signatures] in "GHC.Hs.Decls"
905 _ -> False
906
907
908
909 ---------------
910 -- | Ensures either that we're in a type or that -XPolyKinds is set
911 checkPolyKinds :: Outputable ty
912 => RnTyKiEnv
913 -> ty -- ^ type
914 -> RnM ()
915 checkPolyKinds env ty
916 | isRnKindLevel env
917 = do { polykinds <- xoptM LangExt.PolyKinds
918 ; unless polykinds $
919 addErr $ TcRnUnknownMessage $ mkPlainError noHints $
920 (text "Illegal kind:" <+> ppr ty $$
921 text "Did you mean to enable PolyKinds?") }
922 checkPolyKinds _ _ = return ()
923
924 notInKinds :: Outputable ty
925 => RnTyKiEnv
926 -> ty
927 -> RnM ()
928 notInKinds env ty
929 | isRnKindLevel env
930 = addErr $ TcRnUnknownMessage $ mkPlainError noHints $
931 text "Illegal kind:" <+> ppr ty
932 notInKinds _ _ = return ()
933
934 {- *****************************************************
935 * *
936 Binding type variables
937 * *
938 ***************************************************** -}
939
940 bindSigTyVarsFV :: [Name]
941 -> RnM (a, FreeVars)
942 -> RnM (a, FreeVars)
943 -- Used just before renaming the defn of a function
944 -- with a separate type signature, to bring its tyvars into scope
945 -- With no -XScopedTypeVariables, this is a no-op
946 bindSigTyVarsFV tvs thing_inside
947 = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables
948 ; if not scoped_tyvars then
949 thing_inside
950 else
951 bindLocalNamesFV tvs thing_inside }
952
953 ---------------
954 bindHsQTyVars :: forall a b.
955 HsDocContext
956 -> Maybe a -- Just _ => an associated type decl
957 -> FreeKiTyVars -- Kind variables from scope
958 -> LHsQTyVars GhcPs
959 -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars))
960 -- The Bool is True <=> all kind variables used in the
961 -- kind signature are bound on the left. Reason:
962 -- the last clause of Note [CUSKs: Complete user-supplied
963 -- kind signatures] in GHC.Hs.Decls
964 -> RnM (b, FreeVars)
965
966 -- See Note [bindHsQTyVars examples]
967 -- (a) Bring kind variables into scope
968 -- both (i) passed in body_kv_occs
969 -- and (ii) mentioned in the kinds of hsq_bndrs
970 -- (b) Bring type variables into scope
971 --
972 bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside
973 = do { let bndr_kv_occs = extractHsTyVarBndrsKVs hs_tv_bndrs
974
975 ; let -- See Note [bindHsQTyVars examples] for what
976 -- all these various things are doing
977 bndrs, implicit_kvs :: [LocatedN RdrName]
978 bndrs = map hsLTyVarLocName hs_tv_bndrs
979 implicit_kvs = filterFreeVarsToBind bndrs $
980 bndr_kv_occs ++ body_kv_occs
981 body_remaining = filterFreeVarsToBind bndr_kv_occs $
982 filterFreeVarsToBind bndrs body_kv_occs
983 all_bound_on_lhs = null body_remaining
984
985 ; traceRn "checkMixedVars3" $
986 vcat [ text "bndrs" <+> ppr hs_tv_bndrs
987 , text "bndr_kv_occs" <+> ppr bndr_kv_occs
988 , text "body_kv_occs" <+> ppr body_kv_occs
989 , text "implicit_kvs" <+> ppr implicit_kvs
990 , text "body_remaining" <+> ppr body_remaining
991 ]
992
993 ; rnImplicitTvOccs mb_assoc implicit_kvs $ \ implicit_kv_nms' ->
994 bindLHsTyVarBndrs doc NoWarnUnusedForalls mb_assoc hs_tv_bndrs $ \ rn_bndrs ->
995 -- This is the only call site for bindLHsTyVarBndrs where we pass
996 -- NoWarnUnusedForalls, which suppresses -Wunused-foralls warnings.
997 -- See Note [Suppress -Wunused-foralls when binding LHsQTyVars].
998 do { let -- The SrcSpan that rnImplicitTvOccs will attach to each Name will
999 -- span the entire declaration to which the LHsQTyVars belongs,
1000 -- which will be reflected in warning and error messages. We can
1001 -- be a little more precise than that by pointing to the location
1002 -- of the LHsQTyVars instead, which is what bndrs_loc
1003 -- corresponds to.
1004 implicit_kv_nms = map (`setNameLoc` bndrs_loc) implicit_kv_nms'
1005
1006 ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs)
1007 ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms
1008 , hsq_explicit = rn_bndrs })
1009 all_bound_on_lhs } }
1010 where
1011 hs_tv_bndrs = hsQTvExplicit hsq_bndrs
1012
1013 -- The SrcSpan of the LHsQTyVars. For example, bndrs_loc would be the
1014 -- highlighted part in the class below:
1015 --
1016 -- class C (a :: j) (b :: k) where
1017 -- ^^^^^^^^^^^^^^^
1018 bndrs_loc = case map get_bndr_loc hs_tv_bndrs ++ map getLocA body_kv_occs of
1019 [] -> panic "bindHsQTyVars.bndrs_loc"
1020 [loc] -> loc
1021 (loc:locs) -> loc `combineSrcSpans` last locs
1022
1023 -- The in-tree API annotations extend the LHsTyVarBndr location to
1024 -- include surrounding parens. for error messages to be
1025 -- compatible, we recreate the location from the contents
1026 get_bndr_loc :: LHsTyVarBndr () GhcPs -> SrcSpan
1027 get_bndr_loc (L _ (UserTyVar _ _ ln)) = getLocA ln
1028 get_bndr_loc (L _ (KindedTyVar _ _ ln lk))
1029 = combineSrcSpans (getLocA ln) (getLocA lk)
1030
1031 {- Note [bindHsQTyVars examples]
1032 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1033 Suppose we have
1034 data T k (a::k1) (b::k) :: k2 -> k1 -> *
1035
1036 Then:
1037 hs_tv_bndrs = [k, a::k1, b::k], the explicitly-bound variables
1038 bndrs = [k,a,b]
1039
1040 bndr_kv_occs = [k,k1], kind variables free in kind signatures
1041 of hs_tv_bndrs
1042
1043 body_kv_occs = [k2,k1], kind variables free in the
1044 result kind signature
1045
1046 implicit_kvs = [k1,k2,k1], kind variables free in kind signatures
1047 of hs_tv_bndrs, and not bound by bndrs
1048
1049 * We want to quantify add implicit bindings for implicit_kvs
1050
1051 * If body_kv_occs is non-empty, then there is a kind variable
1052 mentioned in the kind signature that is not bound "on the left".
1053 That's one of the rules for a CUSK, so we pass that info on
1054 as the second argument to thing_inside.
1055
1056 * Order is not important in these lists. All we are doing is
1057 bring Names into scope.
1058
1059 * bndr_kv_occs, body_kv_occs, and implicit_kvs can contain duplicates. All
1060 duplicate occurrences are removed when we bind them with rnImplicitTvOccs.
1061
1062 Finally, you may wonder why filterFreeVarsToBind removes in-scope variables
1063 from bndr/body_kv_occs. How can anything be in scope? Answer:
1064 HsQTyVars is /also/ used (slightly oddly) for Haskell-98 syntax
1065 ConDecls
1066 data T a = forall (b::k). MkT a b
1067 The ConDecl has a LHsQTyVars in it; but 'a' scopes over the entire
1068 ConDecl. Hence the local RdrEnv may be non-empty and we must filter
1069 out 'a' from the free vars. (Mind you, in this situation all the
1070 implicit kind variables are bound at the data type level, so there
1071 are none to bind in the ConDecl, so there are no implicitly bound
1072 variables at all.
1073
1074 Note [Kind variable scoping]
1075 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1076 If we have
1077 data T (a :: k) k = ...
1078 we report "k is out of scope" for (a::k). Reason: k is not brought
1079 into scope until the explicit k-binding that follows. It would be
1080 terribly confusing to bring into scope an /implicit/ k for a's kind
1081 and a distinct, shadowing explicit k that follows, something like
1082 data T {k1} (a :: k1) k = ...
1083
1084 So the rule is:
1085
1086 the implicit binders never include any
1087 of the explicit binders in the group
1088
1089 Note that in the denerate case
1090 data T (a :: a) = blah
1091 we get a complaint the second 'a' is not in scope.
1092
1093 That applies to foralls too: e.g.
1094 forall (a :: k) k . blah
1095
1096 But if the foralls are split, we treat the two groups separately:
1097 forall (a :: k). forall k. blah
1098 Here we bring into scope an implicit k, which is later shadowed
1099 by the explicit k.
1100
1101 In implementation terms
1102
1103 * In bindHsQTyVars 'k' is free in bndr_kv_occs; then we delete
1104 the binders {a,k}, and so end with no implicit binders. Then we
1105 rename the binders left-to-right, and hence see that 'k' is out of
1106 scope in the kind of 'a'.
1107
1108 * Similarly in extract_hs_tv_bndrs
1109
1110 Note [Variables used as both types and kinds]
1111 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1112 We bind the type variables tvs, and kvs is the set of free variables of the
1113 kinds in the scope of the binding. Here is one typical example:
1114
1115 forall a b. a -> (b::k) -> (c::a)
1116
1117 Here, tvs will be {a,b}, and kvs {k,a}.
1118
1119 We must make sure that kvs includes all of variables in the kinds of type
1120 variable bindings. For instance:
1121
1122 forall k (a :: k). Proxy a
1123
1124 If we only look in the body of the `forall` type, we will mistakenly conclude
1125 that kvs is {}. But in fact, the type variable `k` is also used as a kind
1126 variable in (a :: k), later in the binding. (This mistake lead to #14710.)
1127 So tvs is {k,a} and kvs is {k}.
1128
1129 NB: we do this only at the binding site of 'tvs'.
1130
1131 Note [Suppress -Wunused-foralls when binding LHsQTyVars]
1132 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1133 The WarnUnusedForalls flag controls whether bindLHsTyVarBndrs should warn about
1134 explicit type variable binders that go unused (e.g., the `a` in
1135 `forall a. Int`). We almost always want to warn about these, since unused type
1136 variables can usually be deleted without any repercussions. There is one
1137 exception to this rule, however: binding LHsQTyVars. Consider this example:
1138
1139 data Proxy a = Proxy
1140
1141 The `a` in `Proxy a` is bound by an LHsQTyVars, and the code which brings it
1142 into scope, bindHsQTyVars, will invoke bindLHsTyVarBndrs in turn. As such, it
1143 has a choice to make about whether to emit -Wunused-foralls warnings or not.
1144 If it /did/ emit warnings, then the `a` would be flagged as unused. However,
1145 this is not what we want! Removing the `a` in `Proxy a` would change its kind
1146 entirely, which is a huge price to pay for fixing a warning.
1147
1148 Unlike other forms of type variable binders, dropping "unused" variables in
1149 an LHsQTyVars can be semantically significant. As a result, we suppress
1150 -Wunused-foralls warnings in exactly one place: in bindHsQTyVars.
1151 -}
1152
1153 bindHsOuterTyVarBndrs :: OutputableBndrFlag flag 'Renamed
1154 => HsDocContext
1155 -> Maybe assoc
1156 -- ^ @'Just' _@ => an associated type decl
1157 -> FreeKiTyVars
1158 -> HsOuterTyVarBndrs flag GhcPs
1159 -> (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars))
1160 -> RnM (a, FreeVars)
1161 bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside =
1162 case outer_bndrs of
1163 HsOuterImplicit{} ->
1164 rnImplicitTvOccs mb_cls implicit_vars $ \implicit_vars' ->
1165 thing_inside $ HsOuterImplicit { hso_ximplicit = implicit_vars' }
1166 HsOuterExplicit{hso_bndrs = exp_bndrs} ->
1167 -- Note: If we pass mb_cls instead of Nothing below, bindLHsTyVarBndrs
1168 -- will use class variables for any names the user meant to bring in
1169 -- scope here. This is an explicit forall, so we want fresh names, not
1170 -- class variables. Thus: always pass Nothing.
1171 bindLHsTyVarBndrs doc WarnUnusedForalls Nothing exp_bndrs $ \exp_bndrs' ->
1172 thing_inside $ HsOuterExplicit { hso_xexplicit = noExtField
1173 , hso_bndrs = exp_bndrs' }
1174
1175 bindHsForAllTelescope :: HsDocContext
1176 -> HsForAllTelescope GhcPs
1177 -> (HsForAllTelescope GhcRn -> RnM (a, FreeVars))
1178 -> RnM (a, FreeVars)
1179 bindHsForAllTelescope doc tele thing_inside =
1180 case tele of
1181 HsForAllVis { hsf_vis_bndrs = bndrs } ->
1182 bindLHsTyVarBndrs doc WarnUnusedForalls Nothing bndrs $ \bndrs' ->
1183 thing_inside $ mkHsForAllVisTele noAnn bndrs'
1184 HsForAllInvis { hsf_invis_bndrs = bndrs } ->
1185 bindLHsTyVarBndrs doc WarnUnusedForalls Nothing bndrs $ \bndrs' ->
1186 thing_inside $ mkHsForAllInvisTele noAnn bndrs'
1187
1188 -- | Should GHC warn if a quantified type variable goes unused? Usually, the
1189 -- answer is \"yes\", but in the particular case of binding 'LHsQTyVars', we
1190 -- avoid emitting warnings.
1191 -- See @Note [Suppress -Wunused-foralls when binding LHsQTyVars]@.
1192 data WarnUnusedForalls
1193 = WarnUnusedForalls
1194 | NoWarnUnusedForalls
1195
1196 instance Outputable WarnUnusedForalls where
1197 ppr wuf = text $ case wuf of
1198 WarnUnusedForalls -> "WarnUnusedForalls"
1199 NoWarnUnusedForalls -> "NoWarnUnusedForalls"
1200
1201 bindLHsTyVarBndrs :: (OutputableBndrFlag flag 'Renamed)
1202 => HsDocContext
1203 -> WarnUnusedForalls
1204 -> Maybe a -- Just _ => an associated type decl
1205 -> [LHsTyVarBndr flag GhcPs] -- User-written tyvars
1206 -> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars))
1207 -> RnM (b, FreeVars)
1208 bindLHsTyVarBndrs doc wuf mb_assoc tv_bndrs thing_inside
1209 = do { when (isNothing mb_assoc) (checkShadowedRdrNames tv_names_w_loc)
1210 ; checkDupRdrNamesN tv_names_w_loc
1211 ; go tv_bndrs thing_inside }
1212 where
1213 tv_names_w_loc = map hsLTyVarLocName tv_bndrs
1214
1215 go [] thing_inside = thing_inside []
1216 go (b:bs) thing_inside = bindLHsTyVarBndr doc mb_assoc b $ \ b' ->
1217 do { (res, fvs) <- go bs $ \ bs' ->
1218 thing_inside (b' : bs')
1219 ; warn_unused b' fvs
1220 ; return (res, fvs) }
1221
1222 warn_unused tv_bndr fvs = case wuf of
1223 WarnUnusedForalls -> warnUnusedForAll doc tv_bndr fvs
1224 NoWarnUnusedForalls -> return ()
1225
1226 bindLHsTyVarBndr :: HsDocContext
1227 -> Maybe a -- associated class
1228 -> LHsTyVarBndr flag GhcPs
1229 -> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars))
1230 -> RnM (b, FreeVars)
1231 bindLHsTyVarBndr _doc mb_assoc (L loc
1232 (UserTyVar x fl
1233 lrdr@(L lv _))) thing_inside
1234 = do { nm <- newTyVarNameRn mb_assoc lrdr
1235 ; bindLocalNamesFV [nm] $
1236 thing_inside (L loc (UserTyVar x fl (L lv nm))) }
1237
1238 bindLHsTyVarBndr doc mb_assoc (L loc (KindedTyVar x fl lrdr@(L lv _) kind))
1239 thing_inside
1240 = do { sig_ok <- xoptM LangExt.KindSignatures
1241 ; unless sig_ok (badKindSigErr doc kind)
1242 ; (kind', fvs1) <- rnLHsKind doc kind
1243 ; tv_nm <- newTyVarNameRn mb_assoc lrdr
1244 ; (b, fvs2) <- bindLocalNamesFV [tv_nm]
1245 $ thing_inside (L loc (KindedTyVar x fl (L lv tv_nm) kind'))
1246 ; return (b, fvs1 `plusFV` fvs2) }
1247
1248 newTyVarNameRn :: Maybe a -- associated class
1249 -> LocatedN RdrName -> RnM Name
1250 newTyVarNameRn mb_assoc lrdr@(L _ rdr)
1251 = do { rdr_env <- getLocalRdrEnv
1252 ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of
1253 (Just _, Just n) -> return n
1254 -- Use the same Name as the parent class decl
1255
1256 _ -> newLocalBndrRn lrdr }
1257 {-
1258 *********************************************************
1259 * *
1260 ConDeclField
1261 * *
1262 *********************************************************
1263
1264 When renaming a ConDeclField, we have to find the FieldLabel
1265 associated with each field. But we already have all the FieldLabels
1266 available (since they were brought into scope by
1267 GHC.Rename.Names.getLocalNonValBinders), so we just take the list as an
1268 argument, build a map and look them up.
1269 -}
1270
1271 rnConDeclFields :: HsDocContext -> [FieldLabel] -> [LConDeclField GhcPs]
1272 -> RnM ([LConDeclField GhcRn], FreeVars)
1273 -- Also called from GHC.Rename.Module
1274 -- No wildcards can appear in record fields
1275 rnConDeclFields ctxt fls fields
1276 = mapFvRn (rnField fl_env env) fields
1277 where
1278 env = mkTyKiEnv ctxt TypeLevel RnTypeBody
1279 fl_env = mkFsEnv [ (flLabel fl, fl) | fl <- fls ]
1280
1281 rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField GhcPs
1282 -> RnM (LConDeclField GhcRn, FreeVars)
1283 rnField fl_env env (L l (ConDeclField _ names ty haddock_doc))
1284 = do { let new_names = map (fmap (lookupField fl_env)) names
1285 ; (new_ty, fvs) <- rnLHsTyKi env ty
1286 ; return (L l (ConDeclField noAnn new_names new_ty haddock_doc)
1287 , fvs) }
1288
1289 lookupField :: FastStringEnv FieldLabel -> FieldOcc GhcPs -> FieldOcc GhcRn
1290 lookupField fl_env (FieldOcc _ (L lr rdr)) =
1291 FieldOcc (flSelector fl) (L lr rdr)
1292 where
1293 lbl = occNameFS $ rdrNameOcc rdr
1294 fl = expectJust "lookupField" $ lookupFsEnv fl_env lbl
1295
1296 {-
1297 ************************************************************************
1298 * *
1299 Fixities and precedence parsing
1300 * *
1301 ************************************************************************
1302
1303 @mkOpAppRn@ deals with operator fixities. The argument expressions
1304 are assumed to be already correctly arranged. It needs the fixities
1305 recorded in the OpApp nodes, because fixity info applies to the things
1306 the programmer actually wrote, so you can't find it out from the Name.
1307
1308 Furthermore, the second argument is guaranteed not to be another
1309 operator application. Why? Because the parser parses all
1310 operator applications left-associatively, EXCEPT negation, which
1311 we need to handle specially.
1312 Infix types are read in a *right-associative* way, so that
1313 a `op` b `op` c
1314 is always read in as
1315 a `op` (b `op` c)
1316
1317 mkHsOpTyRn rearranges where necessary. The two arguments
1318 have already been renamed and rearranged.
1319
1320 In the past, mkHsOpTyRn used to handle (->), but this was unnecessary. In the
1321 syntax tree produced by the parser, the arrow already has the least possible
1322 precedence and does not require rearrangement.
1323 -}
1324
1325 ---------------
1326 -- Building (ty1 `op1` (ty21 `op2` ty22))
1327 mkHsOpTyRn :: LocatedN Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn
1328 -> RnM (HsType GhcRn)
1329
1330 mkHsOpTyRn op1 fix1 ty1 (L loc2 (HsOpTy _ ty21 op2 ty22))
1331 = do { fix2 <- lookupTyFixityRn op2
1332 ; mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 }
1333
1334 mkHsOpTyRn op1 _ ty1 ty2 -- Default case, no rearrangment
1335 = return (HsOpTy noExtField ty1 op1 ty2)
1336
1337 ---------------
1338 mk_hs_op_ty :: LocatedN Name -> Fixity -> LHsType GhcRn
1339 -> LocatedN Name -> Fixity -> LHsType GhcRn
1340 -> LHsType GhcRn -> SrcSpanAnnA
1341 -> RnM (HsType GhcRn)
1342 mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2
1343 | nofix_error = do { precParseErr (NormalOp (unLoc op1),fix1)
1344 (NormalOp (unLoc op2),fix2)
1345 ; return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) }
1346 | associate_right = return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22)))
1347 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
1348 new_ty <- mkHsOpTyRn op1 fix1 ty1 ty21
1349 ; return (noLocA new_ty `op2ty` ty22) }
1350 where
1351 lhs `op1ty` rhs = HsOpTy noExtField lhs op1 rhs
1352 lhs `op2ty` rhs = HsOpTy noExtField lhs op2 rhs
1353 (nofix_error, associate_right) = compareFixity fix1 fix2
1354
1355
1356 ---------------------------
1357 mkOpAppRn :: NegationHandling
1358 -> LHsExpr GhcRn -- Left operand; already rearranged
1359 -> LHsExpr GhcRn -> Fixity -- Operator and fixity
1360 -> LHsExpr GhcRn -- Right operand (not an OpApp, but might
1361 -- be a NegApp)
1362 -> RnM (HsExpr GhcRn)
1363
1364 -- (e11 `op1` e12) `op2` e2
1365 mkOpAppRn negation_handling e1@(L _ (OpApp fix1 e11 op1 e12)) op2 fix2 e2
1366 | nofix_error
1367 = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
1368 return (OpApp fix2 e1 op2 e2)
1369
1370 | associate_right = do
1371 new_e <- mkOpAppRn negation_handling e12 op2 fix2 e2
1372 return (OpApp fix1 e11 op1 (L loc' new_e))
1373 where
1374 loc'= combineLocsA e12 e2
1375 (nofix_error, associate_right) = compareFixity fix1 fix2
1376
1377 ---------------------------
1378 -- (- neg_arg) `op` e2
1379 mkOpAppRn ReassociateNegation e1@(L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2
1380 | nofix_error
1381 = do precParseErr (NegateOp,negateFixity) (get_op op2,fix2)
1382 return (OpApp fix2 e1 op2 e2)
1383
1384 | associate_right
1385 = do new_e <- mkOpAppRn ReassociateNegation neg_arg op2 fix2 e2
1386 return (NegApp noExtField (L loc' new_e) neg_name)
1387 where
1388 loc' = combineLocsA neg_arg e2
1389 (nofix_error, associate_right) = compareFixity negateFixity fix2
1390
1391 ---------------------------
1392 -- e1 `op` - neg_arg
1393 mkOpAppRn ReassociateNegation e1 op1 fix1 e2@(L _ (NegApp {})) -- NegApp can occur on the right
1394 | not associate_right -- We *want* right association
1395 = do precParseErr (get_op op1, fix1) (NegateOp, negateFixity)
1396 return (OpApp fix1 e1 op1 e2)
1397 where
1398 (_, associate_right) = compareFixity fix1 negateFixity
1399
1400 ---------------------------
1401 -- Default case
1402 mkOpAppRn _ e1 op fix e2 -- Default case, no rearrangment
1403 = assertPpr (right_op_ok fix (unLoc e2))
1404 (ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2) $
1405 return (OpApp fix e1 op e2)
1406
1407 data NegationHandling = ReassociateNegation | KeepNegationIntact
1408
1409 ----------------------------
1410
1411 -- | Name of an operator in an operator application or section
1412 data OpName = NormalOp Name -- ^ A normal identifier
1413 | NegateOp -- ^ Prefix negation
1414 | UnboundOp OccName -- ^ An unbound indentifier
1415 | RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence
1416
1417 instance Outputable OpName where
1418 ppr (NormalOp n) = ppr n
1419 ppr NegateOp = ppr negateName
1420 ppr (UnboundOp uv) = ppr uv
1421 ppr (RecFldOp fld) = ppr fld
1422
1423 get_op :: LHsExpr GhcRn -> OpName
1424 -- An unbound name could be either HsVar or HsUnboundVar
1425 -- See GHC.Rename.Expr.rnUnboundVar
1426 get_op (L _ (HsVar _ n)) = NormalOp (unLoc n)
1427 get_op (L _ (HsUnboundVar _ uv)) = UnboundOp uv
1428 get_op (L _ (HsRecSel _ fld)) = RecFldOp fld
1429 get_op other = pprPanic "get_op" (ppr other)
1430
1431 -- Parser left-associates everything, but
1432 -- derived instances may have correctly-associated things to
1433 -- in the right operand. So we just check that the right operand is OK
1434 right_op_ok :: Fixity -> HsExpr GhcRn -> Bool
1435 right_op_ok fix1 (OpApp fix2 _ _ _)
1436 = not error_please && associate_right
1437 where
1438 (error_please, associate_right) = compareFixity fix1 fix2
1439 right_op_ok _ _
1440 = True
1441
1442 -- Parser initially makes negation bind more tightly than any other operator
1443 -- And "deriving" code should respect this (use HsPar if not)
1444 mkNegAppRn :: LHsExpr GhcRn -> SyntaxExpr GhcRn -> RnM (HsExpr GhcRn)
1445 mkNegAppRn neg_arg neg_name
1446 = assert (not_op_app (unLoc neg_arg)) $
1447 return (NegApp noExtField neg_arg neg_name)
1448
1449 not_op_app :: HsExpr id -> Bool
1450 not_op_app (OpApp {}) = False
1451 not_op_app _ = True
1452
1453 ---------------------------
1454 mkOpFormRn :: LHsCmdTop GhcRn -- Left operand; already rearranged
1455 -> LHsExpr GhcRn -> Fixity -- Operator and fixity
1456 -> LHsCmdTop GhcRn -- Right operand (not an infix)
1457 -> RnM (HsCmd GhcRn)
1458
1459 -- (e11 `op1` e12) `op2` e2
1460 mkOpFormRn a1@(L loc
1461 (HsCmdTop _
1462 (L _ (HsCmdArrForm x op1 f (Just fix1)
1463 [a11,a12]))))
1464 op2 fix2 a2
1465 | nofix_error
1466 = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
1467 return (HsCmdArrForm x op2 f (Just fix2) [a1, a2])
1468
1469 | associate_right
1470 = do new_c <- mkOpFormRn a12 op2 fix2 a2
1471 return (HsCmdArrForm noExtField op1 f (Just fix1)
1472 [a11, L loc (HsCmdTop [] (L (l2l loc) new_c))])
1473 -- TODO: locs are wrong
1474 where
1475 (nofix_error, associate_right) = compareFixity fix1 fix2
1476
1477 -- Default case
1478 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
1479 = return (HsCmdArrForm noExtField op Infix (Just fix) [arg1, arg2])
1480
1481
1482 --------------------------------------
1483 mkConOpPatRn :: LocatedN Name -> Fixity -> LPat GhcRn -> LPat GhcRn
1484 -> RnM (Pat GhcRn)
1485
1486 mkConOpPatRn op2 fix2 p1@(L loc (ConPat NoExtField op1 (InfixCon p11 p12))) p2
1487 = do { fix1 <- lookupFixityRn (unLoc op1)
1488 ; let (nofix_error, associate_right) = compareFixity fix1 fix2
1489
1490 ; if nofix_error then do
1491 { precParseErr (NormalOp (unLoc op1),fix1)
1492 (NormalOp (unLoc op2),fix2)
1493 ; return $ ConPat
1494 { pat_con_ext = noExtField
1495 , pat_con = op2
1496 , pat_args = InfixCon p1 p2
1497 }
1498 }
1499
1500 else if associate_right then do
1501 { new_p <- mkConOpPatRn op2 fix2 p12 p2
1502 ; return $ ConPat
1503 { pat_con_ext = noExtField
1504 , pat_con = op1
1505 , pat_args = InfixCon p11 (L loc new_p)
1506 }
1507 }
1508 -- XXX loc right?
1509 else return $ ConPat
1510 { pat_con_ext = noExtField
1511 , pat_con = op2
1512 , pat_args = InfixCon p1 p2
1513 }
1514 }
1515
1516 mkConOpPatRn op _ p1 p2 -- Default case, no rearrangment
1517 = assert (not_op_pat (unLoc p2)) $
1518 return $ ConPat
1519 { pat_con_ext = noExtField
1520 , pat_con = op
1521 , pat_args = InfixCon p1 p2
1522 }
1523
1524 not_op_pat :: Pat GhcRn -> Bool
1525 not_op_pat (ConPat NoExtField _ (InfixCon _ _)) = False
1526 not_op_pat _ = True
1527
1528 --------------------------------------
1529 checkPrecMatch :: Name -> MatchGroup GhcRn body -> RnM ()
1530 -- Check precedence of a function binding written infix
1531 -- eg a `op` b `C` c = ...
1532 -- See comments with rnExpr (OpApp ...) about "deriving"
1533
1534 checkPrecMatch op (MG { mg_alts = (L _ ms) })
1535 = mapM_ check ms
1536 where
1537 check (L _ (Match { m_pats = (L l1 p1)
1538 : (L l2 p2)
1539 : _ }))
1540 = setSrcSpan (locA $ combineSrcSpansA l1 l2) $
1541 do checkPrec op p1 False
1542 checkPrec op p2 True
1543
1544 check _ = return ()
1545 -- This can happen. Consider
1546 -- a `op` True = ...
1547 -- op = ...
1548 -- The infix flag comes from the first binding of the group
1549 -- but the second eqn has no args (an error, but not discovered
1550 -- until the type checker). So we don't want to crash on the
1551 -- second eqn.
1552
1553 checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
1554 checkPrec op (ConPat NoExtField op1 (InfixCon _ _)) right = do
1555 op_fix@(Fixity _ op_prec op_dir) <- lookupFixityRn op
1556 op1_fix@(Fixity _ op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
1557 let
1558 inf_ok = op1_prec > op_prec ||
1559 (op1_prec == op_prec &&
1560 (op1_dir == InfixR && op_dir == InfixR && right ||
1561 op1_dir == InfixL && op_dir == InfixL && not right))
1562
1563 info = (NormalOp op, op_fix)
1564 info1 = (NormalOp (unLoc op1), op1_fix)
1565 (infol, infor) = if right then (info, info1) else (info1, info)
1566 unless inf_ok (precParseErr infol infor)
1567
1568 checkPrec _ _ _
1569 = return ()
1570
1571 -- Check precedence of (arg op) or (op arg) respectively
1572 -- If arg is itself an operator application, then either
1573 -- (a) its precedence must be higher than that of op
1574 -- (b) its precedency & associativity must be the same as that of op
1575 checkSectionPrec :: FixityDirection -> HsExpr GhcPs
1576 -> LHsExpr GhcRn -> LHsExpr GhcRn -> RnM ()
1577 checkSectionPrec direction section op arg
1578 = case unLoc arg of
1579 OpApp fix _ op' _ -> go_for_it (get_op op') fix
1580 NegApp _ _ _ -> go_for_it NegateOp negateFixity
1581 _ -> return ()
1582 where
1583 op_name = get_op op
1584 go_for_it arg_op arg_fix@(Fixity _ arg_prec assoc) = do
1585 op_fix@(Fixity _ op_prec _) <- lookupFixityOp op_name
1586 unless (op_prec < arg_prec
1587 || (op_prec == arg_prec && direction == assoc))
1588 (sectionPrecErr (get_op op, op_fix)
1589 (arg_op, arg_fix) section)
1590
1591 -- | Look up the fixity for an operator name. Be careful to use
1592 -- 'lookupFieldFixityRn' for record fields (see #13132).
1593 lookupFixityOp :: OpName -> RnM Fixity
1594 lookupFixityOp (NormalOp n) = lookupFixityRn n
1595 lookupFixityOp NegateOp = lookupFixityRn negateName
1596 lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName u)
1597 lookupFixityOp (RecFldOp f) = lookupFieldFixityRn f
1598
1599
1600 -- Precedence-related error messages
1601
1602 precParseErr :: (OpName,Fixity) -> (OpName,Fixity) -> RnM ()
1603 precParseErr op1@(n1,_) op2@(n2,_)
1604 | is_unbound n1 || is_unbound n2
1605 = return () -- Avoid error cascade
1606 | otherwise
1607 = addErr $ TcRnUnknownMessage $ mkPlainError noHints $
1608 hang (text "Precedence parsing error")
1609 4 (hsep [text "cannot mix", ppr_opfix op1, text "and",
1610 ppr_opfix op2,
1611 text "in the same infix expression"])
1612
1613 sectionPrecErr :: (OpName,Fixity) -> (OpName,Fixity) -> HsExpr GhcPs -> RnM ()
1614 sectionPrecErr op@(n1,_) arg_op@(n2,_) section
1615 | is_unbound n1 || is_unbound n2
1616 = return () -- Avoid error cascade
1617 | otherwise
1618 = addErr $ TcRnUnknownMessage $ mkPlainError noHints $
1619 vcat [text "The operator" <+> ppr_opfix op <+> text "of a section",
1620 nest 4 (sep [text "must have lower precedence than that of the operand,",
1621 nest 2 (text "namely" <+> ppr_opfix arg_op)]),
1622 nest 4 (text "in the section:" <+> quotes (ppr section))]
1623
1624 is_unbound :: OpName -> Bool
1625 is_unbound (NormalOp n) = isUnboundName n
1626 is_unbound UnboundOp{} = True
1627 is_unbound _ = False
1628
1629 ppr_opfix :: (OpName, Fixity) -> SDoc
1630 ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
1631 where
1632 pp_op | NegateOp <- op = text "prefix `-'"
1633 | otherwise = quotes (ppr op)
1634
1635
1636 {- *****************************************************
1637 * *
1638 Errors
1639 * *
1640 ***************************************************** -}
1641
1642 unexpectedPatSigTypeErr :: HsPatSigType GhcPs -> TcRnMessage
1643 unexpectedPatSigTypeErr ty
1644 = TcRnUnknownMessage $ mkPlainError noHints $
1645 hang (text "Illegal type signature:" <+> quotes (ppr ty))
1646 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables")
1647
1648 badKindSigErr :: HsDocContext -> LHsType GhcPs -> TcM ()
1649 badKindSigErr doc (L loc ty)
1650 = setSrcSpanA loc $ addErr $ TcRnUnknownMessage $ mkPlainError noHints $
1651 withHsDocContext doc $
1652 hang (text "Illegal kind signature:" <+> quotes (ppr ty))
1653 2 (text "Perhaps you intended to use KindSignatures")
1654
1655 dataKindsErr :: RnTyKiEnv -> HsType GhcPs -> TcRnMessage
1656 dataKindsErr env thing
1657 = TcRnUnknownMessage $ mkPlainError noHints $
1658 hang (text "Illegal" <+> pp_what <> colon <+> quotes (ppr thing))
1659 2 (text "Perhaps you intended to use DataKinds")
1660 where
1661 pp_what | isRnKindLevel env = text "kind"
1662 | otherwise = text "type"
1663
1664 warnUnusedForAll :: OutputableBndrFlag flag 'Renamed
1665 => HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcM ()
1666 warnUnusedForAll doc (L loc tv) used_names
1667 = unless (hsTyVarName tv `elemNameSet` used_names) $ do
1668 let msg = TcRnUnknownMessage $
1669 mkPlainDiagnostic (WarningWithFlag Opt_WarnUnusedForalls) noHints $
1670 vcat [ text "Unused quantified type variable" <+> quotes (ppr tv)
1671 , inHsDocContext doc ]
1672 addDiagnosticAt (locA loc) msg
1673
1674 opTyErr :: Outputable a => RdrName -> a -> SDoc
1675 opTyErr op overall_ty
1676 = hang (text "Illegal operator" <+> quotes (ppr op) <+> text "in type" <+> quotes (ppr overall_ty))
1677 2 (text "Use TypeOperators to allow operators in types")
1678
1679 {-
1680 ************************************************************************
1681 * *
1682 Finding the free type variables of a (HsType RdrName)
1683 * *
1684 ************************************************************************
1685
1686
1687 Note [Kind and type-variable binders]
1688 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1689 In a type signature we may implicitly bind type/kind variables. For example:
1690 * f :: a -> a
1691 f = ...
1692 Here we need to find the free type variables of (a -> a),
1693 so that we know what to quantify
1694
1695 * class C (a :: k) where ...
1696 This binds 'k' in ..., as well as 'a'
1697
1698 * f (x :: a -> [a]) = ....
1699 Here we bind 'a' in ....
1700
1701 * f (x :: T a -> T (b :: k)) = ...
1702 Here we bind both 'a' and the kind variable 'k'
1703
1704 * type instance F (T (a :: Maybe k)) = ...a...k...
1705 Here we want to constrain the kind of 'a', and bind 'k'.
1706
1707 To do that, we need to walk over a type and find its free type/kind variables.
1708 We preserve the left-to-right order of each variable occurrence.
1709 See Note [Ordering of implicit variables].
1710
1711 It is common for lists of free type variables to contain duplicates. For
1712 example, in `f :: a -> a`, the free type variable list is [a, a]. When these
1713 implicitly bound variables are brought into scope (with rnImplicitTvOccs),
1714 duplicates are removed with nubL.
1715
1716 Note [Ordering of implicit variables]
1717 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1718 Since the advent of -XTypeApplications, GHC makes promises about the ordering
1719 of implicit variable quantification. Specifically, we offer that implicitly
1720 quantified variables (such as those in const :: a -> b -> a, without a `forall`)
1721 will occur in left-to-right order of first occurrence. Here are a few examples:
1722
1723 const :: a -> b -> a -- forall a b. ...
1724 f :: Eq a => b -> a -> a -- forall a b. ... contexts are included
1725
1726 type a <-< b = b -> a
1727 g :: a <-< b -- forall a b. ... type synonyms matter
1728
1729 class Functor f where
1730 fmap :: (a -> b) -> f a -> f b -- forall f a b. ...
1731 -- The f is quantified by the class, so only a and b are considered in fmap
1732
1733 This simple story is complicated by the possibility of dependency: all variables
1734 must come after any variables mentioned in their kinds.
1735
1736 typeRep :: Typeable a => TypeRep (a :: k) -- forall k a. ...
1737
1738 The k comes first because a depends on k, even though the k appears later than
1739 the a in the code. Thus, GHC does ScopedSort on the variables.
1740 See Note [ScopedSort] in GHC.Core.Type.
1741
1742 Implicitly bound variables are collected by any function which returns a
1743 FreeKiTyVars, which notably includes the `extract-` family of functions
1744 (extractHsTysRdrTyVars, extractHsTyVarBndrsKVs, etc.).
1745 These functions thus promise to keep left-to-right ordering.
1746
1747 Note [Implicit quantification in type synonyms]
1748 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1749 We typically bind type/kind variables implicitly when they are in a kind
1750 annotation on the LHS, for example:
1751
1752 data Proxy (a :: k) = Proxy
1753 type KindOf (a :: k) = k
1754
1755 Here 'k' is in the kind annotation of a type variable binding, KindedTyVar, and
1756 we want to implicitly quantify over it. This is easy: just extract all free
1757 variables from the kind signature. That's what we do in extract_hs_tv_bndrs_kvs
1758
1759 By contrast, on the RHS we can't simply collect *all* free variables. Which of
1760 the following are allowed?
1761
1762 type TySyn1 = a :: Type
1763 type TySyn2 = 'Nothing :: Maybe a
1764 type TySyn3 = 'Just ('Nothing :: Maybe a)
1765 type TySyn4 = 'Left a :: Either Type a
1766
1767 After some design deliberations (see non-taken alternatives below), the answer
1768 is to reject TySyn1 and TySyn3, but allow TySyn2 and TySyn4, at least for now.
1769 We implicitly quantify over free variables of the outermost kind signature, if
1770 one exists:
1771
1772 * In TySyn1, the outermost kind signature is (:: Type), and it does not have
1773 any free variables.
1774 * In TySyn2, the outermost kind signature is (:: Maybe a), it contains a
1775 free variable 'a', which we implicitly quantify over.
1776 * In TySyn3, there is no outermost kind signature. The (:: Maybe a) signature
1777 is hidden inside 'Just.
1778 * In TySyn4, the outermost kind signature is (:: Either Type a), it contains
1779 a free variable 'a', which we implicitly quantify over. That is why we can
1780 also use it to the left of the double colon: 'Left a
1781
1782 The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type
1783 synonyms and type family instances.
1784
1785 This is something of a stopgap solution until we can explicitly bind invisible
1786 type/kind variables:
1787
1788 type TySyn3 :: forall a. Maybe a
1789 type TySyn3 @a = 'Just ('Nothing :: Maybe a)
1790
1791 Note [Implicit quantification in type synonyms: non-taken alternatives]
1792 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1793
1794 Alternative I: No quantification
1795 --------------------------------
1796 We could offer no implicit quantification on the RHS, accepting none of the
1797 TySyn<N> examples. The user would have to bind the variables explicitly:
1798
1799 type TySyn1 a = a :: Type
1800 type TySyn2 a = 'Nothing :: Maybe a
1801 type TySyn3 a = 'Just ('Nothing :: Maybe a)
1802 type TySyn4 a = 'Left a :: Either Type a
1803
1804 However, this would mean that one would have to specify 'a' at call sites every
1805 time, which could be undesired.
1806
1807 Alternative II: Indiscriminate quantification
1808 ---------------------------------------------
1809 We could implicitly quantify over all free variables on the RHS just like we do
1810 on the LHS. Then we would infer the following kinds:
1811
1812 TySyn1 :: forall {a}. Type
1813 TySyn2 :: forall {a}. Maybe a
1814 TySyn3 :: forall {a}. Maybe (Maybe a)
1815 TySyn4 :: forall {a}. Either Type a
1816
1817 This would work fine for TySyn<2,3,4>, but TySyn1 is clearly bogus: the variable
1818 is free-floating, not fixed by anything.
1819
1820 Alternative III: reportFloatingKvs
1821 ----------------------------------
1822 We could augment Alternative II by hunting down free-floating variables during
1823 type checking. While viable, this would mean we'd end up accepting this:
1824
1825 data Prox k (a :: k)
1826 type T = Prox k
1827
1828 -}
1829
1830 -- A list of free type/kind variables, which can contain duplicates.
1831 -- See Note [Kind and type-variable binders]
1832 -- These lists are guaranteed to preserve left-to-right ordering of
1833 -- the types the variables were extracted from. See also
1834 -- Note [Ordering of implicit variables].
1835 type FreeKiTyVars = [LocatedN RdrName]
1836
1837 -- | Filter out any type and kind variables that are already in scope in the
1838 -- the supplied LocalRdrEnv. Note that this includes named wildcards, which
1839 -- look like perfectly ordinary type variables at this point.
1840 filterInScope :: LocalRdrEnv -> FreeKiTyVars -> FreeKiTyVars
1841 filterInScope rdr_env = filterOut (inScope rdr_env . unLoc)
1842
1843 -- | Filter out any type and kind variables that are already in scope in the
1844 -- the environment's LocalRdrEnv. Note that this includes named wildcards,
1845 -- which look like perfectly ordinary type variables at this point.
1846 filterInScopeM :: FreeKiTyVars -> RnM FreeKiTyVars
1847 filterInScopeM vars
1848 = do { rdr_env <- getLocalRdrEnv
1849 ; return (filterInScope rdr_env vars) }
1850
1851 inScope :: LocalRdrEnv -> RdrName -> Bool
1852 inScope rdr_env rdr = rdr `elemLocalRdrEnv` rdr_env
1853
1854 extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVars -> FreeKiTyVars
1855 extract_tyarg (HsValArg ty) acc = extract_lty ty acc
1856 extract_tyarg (HsTypeArg _ ki) acc = extract_lty ki acc
1857 extract_tyarg (HsArgPar _) acc = acc
1858
1859 extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVars -> FreeKiTyVars
1860 extract_tyargs args acc = foldr extract_tyarg acc args
1861
1862 extractHsTyArgRdrKiTyVars :: [LHsTypeArg GhcPs] -> FreeKiTyVars
1863 extractHsTyArgRdrKiTyVars args
1864 = extract_tyargs args []
1865
1866 -- | 'extractHsTyRdrTyVars' finds the type/kind variables
1867 -- of a HsType/HsKind.
1868 -- It's used when making the @forall@s explicit.
1869 -- See Note [Kind and type-variable binders]
1870 extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVars
1871 extractHsTyRdrTyVars ty = extract_lty ty []
1872
1873 -- | Extracts the free type/kind variables from the kind signature of a HsType.
1874 -- This is used to implicitly quantify over @k@ in @type T = Nothing :: Maybe k@.
1875 -- The left-to-right order of variables is preserved.
1876 -- See Note [Kind and type-variable binders] and
1877 -- Note [Ordering of implicit variables] and
1878 -- Note [Implicit quantification in type synonyms].
1879 extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVars
1880 extractHsTyRdrTyVarsKindVars (L _ ty) =
1881 case ty of
1882 HsParTy _ ty -> extractHsTyRdrTyVarsKindVars ty
1883 HsKindSig _ _ ki -> extractHsTyRdrTyVars ki
1884 _ -> []
1885
1886 -- | Extracts free type and kind variables from types in a list.
1887 -- When the same name occurs multiple times in the types, all occurrences
1888 -- are returned.
1889 extractHsTysRdrTyVars :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars
1890 extractHsTysRdrTyVars tys = extract_ltys tys
1891
1892 -- Returns the free kind variables of any explicitly-kinded binders, returning
1893 -- variable occurrences in left-to-right order.
1894 -- See Note [Ordering of implicit variables].
1895 -- NB: Does /not/ delete the binders themselves.
1896 -- E.g. given [k1, a:k1, b:k2]
1897 -- the function returns [k1,k2], even though k1 is bound here
1898 extractHsTyVarBndrsKVs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
1899 extractHsTyVarBndrsKVs tv_bndrs = extract_hs_tv_bndrs_kvs tv_bndrs
1900
1901 -- Returns the free kind variables in a type family result signature, returning
1902 -- variable occurrences in left-to-right order.
1903 -- See Note [Ordering of implicit variables].
1904 extractRdrKindSigVars :: LFamilyResultSig GhcPs -> FreeKiTyVars
1905 extractRdrKindSigVars (L _ resultSig) = case resultSig of
1906 KindSig _ k -> extractHsTyRdrTyVars k
1907 TyVarSig _ (L _ (KindedTyVar _ _ _ k)) -> extractHsTyRdrTyVars k
1908 _ -> []
1909
1910 -- | Extracts free type and kind variables from an argument in a GADT
1911 -- constructor, returning variable occurrences in left-to-right order.
1912 -- See @Note [Ordering of implicit variables]@.
1913 extractConDeclGADTDetailsTyVars ::
1914 HsConDeclGADTDetails GhcPs -> FreeKiTyVars -> FreeKiTyVars
1915 extractConDeclGADTDetailsTyVars con_args = case con_args of
1916 PrefixConGADT args -> extract_scaled_ltys args
1917 RecConGADT (L _ flds) _ -> extract_ltys $ map (cd_fld_type . unLoc) $ flds
1918
1919 -- | Get type/kind variables mentioned in the kind signature, preserving
1920 -- left-to-right order:
1921 --
1922 -- * data T a (b :: k1) :: k2 -> k1 -> k2 -> Type -- result: [k2,k1]
1923 -- * data T a (b :: k1) -- result: []
1924 --
1925 -- See Note [Ordering of implicit variables].
1926 extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVars
1927 extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig })
1928 = maybe [] extractHsTyRdrTyVars ksig
1929
1930 extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
1931 extract_lctxt ctxt = extract_ltys (unLoc ctxt)
1932
1933 extract_scaled_ltys :: [HsScaled GhcPs (LHsType GhcPs)]
1934 -> FreeKiTyVars -> FreeKiTyVars
1935 extract_scaled_ltys args acc = foldr extract_scaled_lty acc args
1936
1937 extract_scaled_lty :: HsScaled GhcPs (LHsType GhcPs)
1938 -> FreeKiTyVars -> FreeKiTyVars
1939 extract_scaled_lty (HsScaled m ty) acc = extract_lty ty $ extract_hs_arrow m acc
1940
1941 extract_ltys :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars
1942 extract_ltys tys acc = foldr extract_lty acc tys
1943
1944 extract_lty :: LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
1945 extract_lty (L _ ty) acc
1946 = case ty of
1947 HsTyVar _ _ ltv -> extract_tv ltv acc
1948 HsBangTy _ _ ty -> extract_lty ty acc
1949 HsRecTy _ flds -> foldr (extract_lty
1950 . cd_fld_type . unLoc) acc
1951 flds
1952 HsAppTy _ ty1 ty2 -> extract_lty ty1 $
1953 extract_lty ty2 acc
1954 HsAppKindTy _ ty k -> extract_lty ty $
1955 extract_lty k acc
1956 HsListTy _ ty -> extract_lty ty acc
1957 HsTupleTy _ _ tys -> extract_ltys tys acc
1958 HsSumTy _ tys -> extract_ltys tys acc
1959 HsFunTy _ w ty1 ty2 -> extract_lty ty1 $
1960 extract_lty ty2 $
1961 extract_hs_arrow w acc
1962 HsIParamTy _ _ ty -> extract_lty ty acc
1963 HsOpTy _ ty1 tv ty2 -> extract_tv tv $
1964 extract_lty ty1 $
1965 extract_lty ty2 acc
1966 HsParTy _ ty -> extract_lty ty acc
1967 HsSpliceTy {} -> acc -- Type splices mention no tvs
1968 HsDocTy _ ty _ -> extract_lty ty acc
1969 HsExplicitListTy _ _ tys -> extract_ltys tys acc
1970 HsExplicitTupleTy _ tys -> extract_ltys tys acc
1971 HsTyLit _ _ -> acc
1972 HsStarTy _ _ -> acc
1973 HsKindSig _ ty ki -> extract_lty ty $
1974 extract_lty ki acc
1975 HsForAllTy { hst_tele = tele, hst_body = ty }
1976 -> extract_hs_for_all_telescope tele acc $
1977 extract_lty ty []
1978 HsQualTy { hst_ctxt = ctxt, hst_body = ty }
1979 -> extract_lctxt ctxt $
1980 extract_lty ty acc
1981 XHsType {} -> acc
1982 -- We deal with these separately in rnLHsTypeWithWildCards
1983 HsWildCardTy {} -> acc
1984
1985 extract_lhs_sig_ty :: LHsSigType GhcPs -> FreeKiTyVars
1986 extract_lhs_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) =
1987 extractHsOuterTvBndrs outer_bndrs $ extract_lty body []
1988
1989 extract_hs_arrow :: HsArrow GhcPs -> FreeKiTyVars ->
1990 FreeKiTyVars
1991 extract_hs_arrow (HsExplicitMult _ p _) acc = extract_lty p acc
1992 extract_hs_arrow _ acc = acc
1993
1994 extract_hs_for_all_telescope :: HsForAllTelescope GhcPs
1995 -> FreeKiTyVars -- Accumulator
1996 -> FreeKiTyVars -- Free in body
1997 -> FreeKiTyVars
1998 extract_hs_for_all_telescope tele acc_vars body_fvs =
1999 case tele of
2000 HsForAllVis { hsf_vis_bndrs = bndrs } ->
2001 extract_hs_tv_bndrs bndrs acc_vars body_fvs
2002 HsForAllInvis { hsf_invis_bndrs = bndrs } ->
2003 extract_hs_tv_bndrs bndrs acc_vars body_fvs
2004
2005 extractHsOuterTvBndrs :: HsOuterTyVarBndrs flag GhcPs
2006 -> FreeKiTyVars -- Free in body
2007 -> FreeKiTyVars -- Free in result
2008 extractHsOuterTvBndrs outer_bndrs body_fvs =
2009 case outer_bndrs of
2010 HsOuterImplicit{} -> body_fvs
2011 HsOuterExplicit{hso_bndrs = bndrs} -> extract_hs_tv_bndrs bndrs [] body_fvs
2012
2013 extract_hs_tv_bndrs :: [LHsTyVarBndr flag GhcPs]
2014 -> FreeKiTyVars -- Accumulator
2015 -> FreeKiTyVars -- Free in body
2016 -> FreeKiTyVars
2017 -- In (forall (a :: Maybe e). a -> b) we have
2018 -- 'a' is bound by the forall
2019 -- 'b' is a free type variable
2020 -- 'e' is a free kind variable
2021 extract_hs_tv_bndrs tv_bndrs acc_vars body_vars = new_vars ++ acc_vars
2022 where
2023 new_vars
2024 | null tv_bndrs = body_vars
2025 | otherwise = filterFreeVarsToBind tv_bndr_rdrs $ bndr_vars ++ body_vars
2026 -- NB: delete all tv_bndr_rdrs from bndr_vars as well as body_vars.
2027 -- See Note [Kind variable scoping]
2028 bndr_vars = extract_hs_tv_bndrs_kvs tv_bndrs
2029 tv_bndr_rdrs = map hsLTyVarLocName tv_bndrs
2030
2031 extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
2032 -- Returns the free kind variables of any explicitly-kinded binders, returning
2033 -- variable occurrences in left-to-right order.
2034 -- See Note [Ordering of implicit variables].
2035 -- NB: Does /not/ delete the binders themselves.
2036 -- E.g. given [k1, a:k1, b:k2]
2037 -- the function returns [k1,k2], even though k1 is bound here
2038 extract_hs_tv_bndrs_kvs tv_bndrs =
2039 foldr extract_lty []
2040 [k | L _ (KindedTyVar _ _ _ k) <- tv_bndrs]
2041
2042 extract_tv :: LocatedN RdrName -> FreeKiTyVars -> FreeKiTyVars
2043 extract_tv tv acc =
2044 if isRdrTyVar (unLoc tv) then tv:acc else acc
2045
2046 -- Deletes duplicates in a list of Located things. This is used to:
2047 --
2048 -- * Delete duplicate occurrences of implicitly bound type/kind variables when
2049 -- bringing them into scope (in rnImplicitTvOccs).
2050 --
2051 -- * Delete duplicate occurrences of named wildcards (in rn_hs_sig_wc_type and
2052 -- rnHsWcType).
2053 --
2054 -- Importantly, this function is stable with respect to the original ordering
2055 -- of things in the list. This is important, as it is a property that GHC
2056 -- relies on to maintain the left-to-right ordering of implicitly quantified
2057 -- type variables.
2058 -- See Note [Ordering of implicit variables].
2059 nubL :: Eq a => [GenLocated l a] -> [GenLocated l a]
2060 nubL = nubBy eqLocated
2061
2062 nubN :: Eq a => [LocatedN a] -> [LocatedN a]
2063 nubN = nubBy eqLocated
2064
2065 -- | Filter out any potential implicit binders that are either
2066 -- already in scope, or are explicitly bound in the binder.
2067 filterFreeVarsToBind :: FreeKiTyVars
2068 -- ^ Explicitly bound here
2069 -> FreeKiTyVars
2070 -- ^ Potential implicit binders
2071 -> FreeKiTyVars
2072 -- ^ Final implicit binders
2073 filterFreeVarsToBind bndrs = filterOut is_in_scope
2074 -- Make sure to list the binder kvs before the body kvs, as mandated by
2075 -- Note [Ordering of implicit variables]
2076 where
2077 is_in_scope locc = any (eqLocated locc) bndrs