Fix typo in TcRnTypes.hs [skip ci]
[ghc.git] / compiler / rename / RnTypes.hs
1 {-
2 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3
4 \section[RnSource]{Main pass of renamer}
5 -}
6
7 {-# LANGUAGE ScopedTypeVariables #-}
8 {-# LANGUAGE CPP #-}
9 {-# LANGUAGE ViewPatterns #-}
10 {-# LANGUAGE TypeFamilies #-}
11
12 module RnTypes (
13 -- Type related stuff
14 rnHsType, rnLHsType, rnLHsTypes, rnContext,
15 rnHsKind, rnLHsKind, rnLHsTypeArgs,
16 rnHsSigType, rnHsWcType,
17 HsSigWcTypeScoping(..), rnHsSigWcType, rnHsSigWcTypeScoped,
18 newTyVarNameRn,
19 rnConDeclFields,
20 rnLTyVar,
21
22 -- Precence related stuff
23 mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
24 checkPrecMatch, checkSectionPrec,
25
26 -- Binding related stuff
27 bindLHsTyVarBndr, bindLHsTyVarBndrs, rnImplicitBndrs,
28 bindSigTyVarsFV, bindHsQTyVars, bindLRdrNames,
29 extractFilteredRdrTyVars, extractFilteredRdrTyVarsDups,
30 extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
31 extractHsTyRdrTyVarsDups, extractHsTysRdrTyVars,
32 extractHsTysRdrTyVarsDups, rmDupsInRdrTyVars,
33 extractRdrKindSigVars, extractDataDefnKindVars,
34 extractHsTvBndrs, extractHsTyArgRdrKiTyVarsDup,
35 freeKiTyVarsAllVars, freeKiTyVarsKindVars, freeKiTyVarsTypeVars,
36 elemRdr
37 ) where
38
39 import GhcPrelude
40
41 import {-# SOURCE #-} RnSplice( rnSpliceType )
42
43 import DynFlags
44 import HsSyn
45 import RnHsDoc ( rnLHsDoc, rnMbLHsDoc )
46 import RnEnv
47 import RnUnbound ( perhapsForallMsg )
48 import RnUtils ( HsDocContext(..), withHsDocContext, mapFvRn
49 , pprHsDocContext, bindLocalNamesFV, typeAppErr
50 , newLocalBndrRn, checkDupRdrNames, checkShadowedRdrNames )
51 import RnFixity ( lookupFieldFixityRn, lookupFixityRn
52 , lookupTyFixityRn )
53 import TcRnMonad
54 import RdrName
55 import PrelNames
56 import TysPrim ( funTyConName )
57 import Name
58 import SrcLoc
59 import NameSet
60 import FieldLabel
61
62 import Util
63 import ListSetOps ( deleteBys )
64 import BasicTypes ( compareFixity, funTyFixity, negateFixity,
65 Fixity(..), FixityDirection(..), LexicalFixity(..) )
66 import Outputable
67 import FastString
68 import Maybes
69 import qualified GHC.LanguageExtensions as LangExt
70
71 import Data.List ( nubBy, partition, (\\) )
72 import Control.Monad ( unless, when )
73
74 #include "HsVersions.h"
75
76 {-
77 These type renamers are in a separate module, rather than in (say) RnSource,
78 to break several loop.
79
80 *********************************************************
81 * *
82 HsSigWcType (i.e with wildcards)
83 * *
84 *********************************************************
85 -}
86
87 data HsSigWcTypeScoping = AlwaysBind
88 -- ^ Always bind any free tyvars of the given type,
89 -- regardless of whether we have a forall at the top
90 | BindUnlessForall
91 -- ^ Unless there's forall at the top, do the same
92 -- thing as 'AlwaysBind'
93 | NeverBind
94 -- ^ Never bind any free tyvars
95
96 rnHsSigWcType :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs
97 -> RnM (LHsSigWcType GhcRn, FreeVars)
98 rnHsSigWcType scoping doc sig_ty
99 = rn_hs_sig_wc_type scoping doc sig_ty $ \sig_ty' ->
100 return (sig_ty', emptyFVs)
101
102 rnHsSigWcTypeScoped :: HsSigWcTypeScoping
103 -- AlwaysBind: for pattern type sigs and rules we /do/ want
104 -- to bring those type variables into scope, even
105 -- if there's a forall at the top which usually
106 -- stops that happening
107 -- e.g \ (x :: forall a. a-> b) -> e
108 -- Here we do bring 'b' into scope
109 -> HsDocContext -> LHsSigWcType GhcPs
110 -> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
111 -> RnM (a, FreeVars)
112 -- Used for
113 -- - Signatures on binders in a RULE
114 -- - Pattern type signatures
115 -- Wildcards are allowed
116 -- type signatures on binders only allowed with ScopedTypeVariables
117 rnHsSigWcTypeScoped scoping ctx sig_ty thing_inside
118 = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables
119 ; checkErr ty_sig_okay (unexpectedTypeSigErr sig_ty)
120 ; rn_hs_sig_wc_type scoping ctx sig_ty thing_inside
121 }
122
123 rn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs
124 -> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
125 -> RnM (a, FreeVars)
126 -- rn_hs_sig_wc_type is used for source-language type signatures
127 rn_hs_sig_wc_type scoping ctxt
128 (HsWC { hswc_body = HsIB { hsib_body = hs_ty }})
129 thing_inside
130 = do { free_vars <- extractFilteredRdrTyVarsDups hs_ty
131 ; (tv_rdrs, nwc_rdrs') <- partition_nwcs free_vars
132 ; let nwc_rdrs = nubL nwc_rdrs'
133 bind_free_tvs = case scoping of
134 AlwaysBind -> True
135 BindUnlessForall -> not (isLHsForAllTy hs_ty)
136 NeverBind -> False
137 ; rnImplicitBndrs bind_free_tvs tv_rdrs $ \ vars ->
138 do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty
139 ; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = ib_ty' }
140 ib_ty' = HsIB { hsib_ext = vars
141 , hsib_body = hs_ty' }
142 ; (res, fvs2) <- thing_inside sig_ty'
143 ; return (res, fvs1 `plusFV` fvs2) } }
144 rn_hs_sig_wc_type _ _ (HsWC _ (XHsImplicitBndrs _)) _
145 = panic "rn_hs_sig_wc_type"
146 rn_hs_sig_wc_type _ _ (XHsWildCardBndrs _) _
147 = panic "rn_hs_sig_wc_type"
148
149 rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
150 rnHsWcType ctxt (HsWC { hswc_body = hs_ty })
151 = do { free_vars <- extractFilteredRdrTyVars hs_ty
152 ; (_, nwc_rdrs) <- partition_nwcs free_vars
153 ; (wcs, hs_ty', fvs) <- rnWcBody ctxt nwc_rdrs hs_ty
154 ; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = hs_ty' }
155 ; return (sig_ty', fvs) }
156 rnHsWcType _ (XHsWildCardBndrs _) = panic "rnHsWcType"
157
158 rnWcBody :: HsDocContext -> [Located RdrName] -> LHsType GhcPs
159 -> RnM ([Name], LHsType GhcRn, FreeVars)
160 rnWcBody ctxt nwc_rdrs hs_ty
161 = do { nwcs <- mapM newLocalBndrRn nwc_rdrs
162 ; let env = RTKE { rtke_level = TypeLevel
163 , rtke_what = RnTypeBody
164 , rtke_nwcs = mkNameSet nwcs
165 , rtke_ctxt = ctxt }
166 ; (hs_ty', fvs) <- bindLocalNamesFV nwcs $
167 rn_lty env hs_ty
168 ; return (nwcs, hs_ty', fvs) }
169 where
170 rn_lty env (dL->L loc hs_ty)
171 = setSrcSpan loc $
172 do { (hs_ty', fvs) <- rn_ty env hs_ty
173 ; return (cL loc hs_ty', fvs) }
174
175 rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
176 -- A lot of faff just to allow the extra-constraints wildcard to appear
177 rn_ty env hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_body })
178 = bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc hs_ty) Nothing tvs $ \ tvs' ->
179 do { (hs_body', fvs) <- rn_lty env hs_body
180 ; return (HsForAllTy { hst_xforall = noExt, hst_bndrs = tvs'
181 , hst_body = hs_body' }, fvs) }
182
183 rn_ty env (HsQualTy { hst_ctxt = dL->L cx hs_ctxt
184 , hst_body = hs_ty })
185 | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt
186 , (dL->L lx (HsWildCardTy _)) <- ignoreParens hs_ctxt_last
187 = do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1
188 ; setSrcSpan lx $ checkExtraConstraintWildCard env hs_ctxt1
189 ; let hs_ctxt' = hs_ctxt1' ++ [cL lx (HsWildCardTy noExt)]
190 ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
191 ; return (HsQualTy { hst_xqual = noExt
192 , hst_ctxt = cL cx hs_ctxt', hst_body = hs_ty' }
193 , fvs1 `plusFV` fvs2) }
194
195 | otherwise
196 = do { (hs_ctxt', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt
197 ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
198 ; return (HsQualTy { hst_xqual = noExt
199 , hst_ctxt = cL cx hs_ctxt'
200 , hst_body = hs_ty' }
201 , fvs1 `plusFV` fvs2) }
202
203 rn_ty env hs_ty = rnHsTyKi env hs_ty
204
205 rn_top_constraint env = rnLHsTyKi (env { rtke_what = RnTopConstraint })
206
207
208 checkExtraConstraintWildCard :: RnTyKiEnv -> HsContext GhcPs -> RnM ()
209 -- Rename the extra-constraint spot in a type signature
210 -- (blah, _) => type
211 -- Check that extra-constraints are allowed at all, and
212 -- if so that it's an anonymous wildcard
213 checkExtraConstraintWildCard env hs_ctxt
214 = checkWildCard env mb_bad
215 where
216 mb_bad | not (extraConstraintWildCardsAllowed env)
217 = Just base_msg
218 -- Currently, we do not allow wildcards in their full glory in
219 -- standalone deriving declarations. We only allow a single
220 -- extra-constraints wildcard à la:
221 --
222 -- deriving instance _ => Eq (Foo a)
223 --
224 -- i.e., we don't support things like
225 --
226 -- deriving instance (Eq a, _) => Eq (Foo a)
227 | DerivDeclCtx {} <- rtke_ctxt env
228 , not (null hs_ctxt)
229 = Just deriv_decl_msg
230 | otherwise
231 = Nothing
232
233 base_msg = text "Extra-constraint wildcard" <+> quotes pprAnonWildCard
234 <+> text "not allowed"
235
236 deriv_decl_msg
237 = hang base_msg
238 2 (vcat [ text "except as the sole constraint"
239 , nest 2 (text "e.g., deriving instance _ => Eq (Foo a)") ])
240
241 extraConstraintWildCardsAllowed :: RnTyKiEnv -> Bool
242 extraConstraintWildCardsAllowed env
243 = case rtke_ctxt env of
244 TypeSigCtx {} -> True
245 ExprWithTySigCtx {} -> True
246 DerivDeclCtx {} -> True
247 _ -> False
248
249 -- | Finds free type and kind variables in a type,
250 -- without duplicates, and
251 -- without variables that are already in scope in LocalRdrEnv
252 -- NB: this includes named wildcards, which look like perfectly
253 -- ordinary type variables at this point
254 extractFilteredRdrTyVars :: LHsType GhcPs -> RnM FreeKiTyVarsNoDups
255 extractFilteredRdrTyVars hs_ty
256 = do { rdr_env <- getLocalRdrEnv
257 ; return (filterInScope rdr_env (extractHsTyRdrTyVars hs_ty)) }
258
259 -- | Finds free type and kind variables in a type,
260 -- with duplicates, but
261 -- without variables that are already in scope in LocalRdrEnv
262 -- NB: this includes named wildcards, which look like perfectly
263 -- ordinary type variables at this point
264 extractFilteredRdrTyVarsDups :: LHsType GhcPs -> RnM FreeKiTyVarsWithDups
265 extractFilteredRdrTyVarsDups hs_ty
266 = do { rdr_env <- getLocalRdrEnv
267 ; return (filterInScope rdr_env (extractHsTyRdrTyVarsDups hs_ty)) }
268
269 -- | When the NamedWildCards extension is enabled, partition_nwcs
270 -- removes type variables that start with an underscore from the
271 -- FreeKiTyVars in the argument and returns them in a separate list.
272 -- When the extension is disabled, the function returns the argument
273 -- and empty list. See Note [Renaming named wild cards]
274 partition_nwcs :: FreeKiTyVars -> RnM (FreeKiTyVars, [Located RdrName])
275 partition_nwcs free_vars@(FKTV { fktv_tys = tys })
276 = do { wildcards_enabled <- fmap (xopt LangExt.NamedWildCards) getDynFlags
277 ; let (nwcs, no_nwcs) | wildcards_enabled = partition is_wildcard tys
278 | otherwise = ([], tys)
279 free_vars' = free_vars { fktv_tys = no_nwcs }
280 ; return (free_vars', nwcs) }
281 where
282 is_wildcard :: Located RdrName -> Bool
283 is_wildcard rdr = startsWithUnderscore (rdrNameOcc (unLoc rdr))
284
285 {- Note [Renaming named wild cards]
286 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
287 Identifiers starting with an underscore are always parsed as type variables.
288 It is only here in the renamer that we give the special treatment.
289 See Note [The wildcard story for types] in HsTypes.
290
291 It's easy! When we collect the implicitly bound type variables, ready
292 to bring them into scope, and NamedWildCards is on, we partition the
293 variables into the ones that start with an underscore (the named
294 wildcards) and the rest. Then we just add them to the hswc_wcs field
295 of the HsWildCardBndrs structure, and we are done.
296
297
298 *********************************************************
299 * *
300 HsSigtype (i.e. no wildcards)
301 * *
302 ****************************************************** -}
303
304 rnHsSigType :: HsDocContext -> LHsSigType GhcPs
305 -> RnM (LHsSigType GhcRn, FreeVars)
306 -- Used for source-language type signatures
307 -- that cannot have wildcards
308 rnHsSigType ctx (HsIB { hsib_body = hs_ty })
309 = do { traceRn "rnHsSigType" (ppr hs_ty)
310 ; vars <- extractFilteredRdrTyVarsDups hs_ty
311 ; rnImplicitBndrs (not (isLHsForAllTy hs_ty)) vars $ \ vars ->
312 do { (body', fvs) <- rnLHsType ctx hs_ty
313 ; return ( HsIB { hsib_ext = vars
314 , hsib_body = body' }
315 , fvs ) } }
316 rnHsSigType _ (XHsImplicitBndrs _) = panic "rnHsSigType"
317
318 rnImplicitBndrs :: Bool -- True <=> bring into scope any free type variables
319 -- E.g. f :: forall a. a->b
320 -- we do not want to bring 'b' into scope, hence False
321 -- But f :: a -> b
322 -- we want to bring both 'a' and 'b' into scope
323 -> FreeKiTyVarsWithDups
324 -- Free vars of hs_ty (excluding wildcards)
325 -- May have duplicates, which is
326 -- checked here
327 -> ([Name] -> RnM (a, FreeVars))
328 -> RnM (a, FreeVars)
329 rnImplicitBndrs bind_free_tvs
330 fvs_with_dups@(FKTV { fktv_kis = kvs_with_dups
331 , fktv_tys = tvs_with_dups })
332 thing_inside
333 = do { let FKTV kvs tvs = rmDupsInRdrTyVars fvs_with_dups
334 real_tvs | bind_free_tvs = tvs
335 | otherwise = []
336 -- We always bind over free /kind/ variables.
337 -- Bind free /type/ variables only if there is no
338 -- explicit forall. E.g.
339 -- f :: Proxy (a :: k) -> b
340 -- Quantify over {k} and {a,b}
341 -- g :: forall a. Proxy (a :: k) -> b
342 -- Quantify over {k} and {}
343 -- Note that we always do the implicit kind-quantification
344 -- but, rather arbitrarily, we switch off the type-quantification
345 -- if there is an explicit forall
346
347 ; traceRn "rnImplicitBndrs" (vcat [ ppr kvs, ppr tvs, ppr real_tvs ])
348
349 ; whenWOptM Opt_WarnImplicitKindVars $
350 unless (bind_free_tvs || null kvs) $
351 addWarnAt (Reason Opt_WarnImplicitKindVars) (getLoc (head kvs)) $
352 implicit_kind_vars_msg kvs
353
354 ; loc <- getSrcSpanM
355 -- NB: kinds before tvs, as mandated by
356 -- Note [Ordering of implicit variables]
357 ; vars <- mapM (newLocalBndrRn . cL loc . unLoc) (kvs ++ real_tvs)
358
359 ; traceRn "checkMixedVars2" $
360 vcat [ text "kvs_with_dups" <+> ppr kvs_with_dups
361 , text "tvs_with_dups" <+> ppr tvs_with_dups ]
362
363 ; bindLocalNamesFV vars $
364 thing_inside vars }
365 where
366 implicit_kind_vars_msg kvs =
367 vcat [ text "An explicit" <+> quotes (text "forall") <+>
368 text "was used, but the following kind variables" <+>
369 text "are not quantified:" <+>
370 hsep (punctuate comma (map (quotes . ppr) kvs))
371 , text "Despite this fact, GHC will introduce them into scope," <+>
372 text "but it will stop doing so in the future."
373 , text "Suggested fix: add" <+>
374 quotes (text "forall" <+> hsep (map ppr kvs) <> char '.') ]
375
376 {- ******************************************************
377 * *
378 LHsType and HsType
379 * *
380 ****************************************************** -}
381
382 {-
383 rnHsType is here because we call it from loadInstDecl, and I didn't
384 want a gratuitous knot.
385
386 Note [Context quantification]
387 -----------------------------
388 Variables in type signatures are implicitly quantified
389 when (1) they are in a type signature not beginning
390 with "forall" or (2) in any qualified type T => R.
391 We are phasing out (2) since it leads to inconsistencies
392 (Trac #4426):
393
394 data A = A (a -> a) is an error
395 data A = A (Eq a => a -> a) binds "a"
396 data A = A (Eq a => a -> b) binds "a" and "b"
397 data A = A (() => a -> b) binds "a" and "b"
398 f :: forall a. a -> b is an error
399 f :: forall a. () => a -> b is an error
400 f :: forall a. a -> (() => b) binds "a" and "b"
401
402 This situation is now considered to be an error. See rnHsTyKi for case
403 HsForAllTy Qualified.
404
405 Note [QualTy in kinds]
406 ~~~~~~~~~~~~~~~~~~~~~~
407 I was wondering whether QualTy could occur only at TypeLevel. But no,
408 we can have a qualified type in a kind too. Here is an example:
409
410 type family F a where
411 F Bool = Nat
412 F Nat = Type
413
414 type family G a where
415 G Type = Type -> Type
416 G () = Nat
417
418 data X :: forall k1 k2. (F k1 ~ G k2) => k1 -> k2 -> Type where
419 MkX :: X 'True '()
420
421 See that k1 becomes Bool and k2 becomes (), so the equality is
422 satisfied. If I write MkX :: X 'True 'False, compilation fails with a
423 suitable message:
424
425 MkX :: X 'True '()
426 • Couldn't match kind ‘G Bool’ with ‘Nat’
427 Expected kind: G Bool
428 Actual kind: F Bool
429
430 However: in a kind, the constraints in the QualTy must all be
431 equalities; or at least, any kinds with a class constraint are
432 uninhabited.
433 -}
434
435 data RnTyKiEnv
436 = RTKE { rtke_ctxt :: HsDocContext
437 , rtke_level :: TypeOrKind -- Am I renaming a type or a kind?
438 , rtke_what :: RnTyKiWhat -- And within that what am I renaming?
439 , rtke_nwcs :: NameSet -- These are the in-scope named wildcards
440 }
441
442 data RnTyKiWhat = RnTypeBody
443 | RnTopConstraint -- Top-level context of HsSigWcTypes
444 | RnConstraint -- All other constraints
445
446 instance Outputable RnTyKiEnv where
447 ppr (RTKE { rtke_level = lev, rtke_what = what
448 , rtke_nwcs = wcs, rtke_ctxt = ctxt })
449 = text "RTKE"
450 <+> braces (sep [ ppr lev, ppr what, ppr wcs
451 , pprHsDocContext ctxt ])
452
453 instance Outputable RnTyKiWhat where
454 ppr RnTypeBody = text "RnTypeBody"
455 ppr RnTopConstraint = text "RnTopConstraint"
456 ppr RnConstraint = text "RnConstraint"
457
458 mkTyKiEnv :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
459 mkTyKiEnv cxt level what
460 = RTKE { rtke_level = level, rtke_nwcs = emptyNameSet
461 , rtke_what = what, rtke_ctxt = cxt }
462
463 isRnKindLevel :: RnTyKiEnv -> Bool
464 isRnKindLevel (RTKE { rtke_level = KindLevel }) = True
465 isRnKindLevel _ = False
466
467 --------------
468 rnLHsType :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
469 rnLHsType ctxt ty = rnLHsTyKi (mkTyKiEnv ctxt TypeLevel RnTypeBody) ty
470
471 rnLHsTypes :: HsDocContext -> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
472 rnLHsTypes doc tys = mapFvRn (rnLHsType doc) tys
473
474 rnHsType :: HsDocContext -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
475 rnHsType ctxt ty = rnHsTyKi (mkTyKiEnv ctxt TypeLevel RnTypeBody) ty
476
477 rnLHsKind :: HsDocContext -> LHsKind GhcPs -> RnM (LHsKind GhcRn, FreeVars)
478 rnLHsKind ctxt kind = rnLHsTyKi (mkTyKiEnv ctxt KindLevel RnTypeBody) kind
479
480 rnHsKind :: HsDocContext -> HsKind GhcPs -> RnM (HsKind GhcRn, FreeVars)
481 rnHsKind ctxt kind = rnHsTyKi (mkTyKiEnv ctxt KindLevel RnTypeBody) kind
482
483 -- renaming a type only, not a kind
484 rnLHsTypeArg :: HsDocContext -> LHsTypeArg GhcPs
485 -> RnM (LHsTypeArg GhcRn, FreeVars)
486 rnLHsTypeArg ctxt (HsValArg ty)
487 = do { (tys_rn, fvs) <- rnLHsType ctxt ty
488 ; return (HsValArg tys_rn, fvs) }
489 rnLHsTypeArg ctxt (HsTypeArg ki)
490 = do { (kis_rn, fvs) <- rnLHsKind ctxt ki
491 ; return (HsTypeArg kis_rn, fvs) }
492 rnLHsTypeArg _ (HsArgPar sp)
493 = return (HsArgPar sp, emptyFVs)
494
495 rnLHsTypeArgs :: HsDocContext -> [LHsTypeArg GhcPs]
496 -> RnM ([LHsTypeArg GhcRn], FreeVars)
497 rnLHsTypeArgs doc args = mapFvRn (rnLHsTypeArg doc) args
498
499 --------------
500 rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs
501 -> RnM (LHsContext GhcRn, FreeVars)
502 rnTyKiContext env (dL->L loc cxt)
503 = do { traceRn "rncontext" (ppr cxt)
504 ; let env' = env { rtke_what = RnConstraint }
505 ; (cxt', fvs) <- mapFvRn (rnLHsTyKi env') cxt
506 ; return (cL loc cxt', fvs) }
507
508 rnContext :: HsDocContext -> LHsContext GhcPs
509 -> RnM (LHsContext GhcRn, FreeVars)
510 rnContext doc theta = rnTyKiContext (mkTyKiEnv doc TypeLevel RnConstraint) theta
511
512 --------------
513 rnLHsTyKi :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
514 rnLHsTyKi env (dL->L loc ty)
515 = setSrcSpan loc $
516 do { (ty', fvs) <- rnHsTyKi env ty
517 ; return (cL loc ty', fvs) }
518
519 rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
520
521 rnHsTyKi env ty@(HsForAllTy { hst_bndrs = tyvars, hst_body = tau })
522 = do { checkPolyKinds env ty
523 ; bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc ty)
524 Nothing tyvars $ \ tyvars' ->
525 do { (tau', fvs) <- rnLHsTyKi env tau
526 ; return ( HsForAllTy { hst_xforall = noExt, hst_bndrs = tyvars'
527 , hst_body = tau' }
528 , fvs) } }
529
530 rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau })
531 = do { checkPolyKinds env ty -- See Note [QualTy in kinds]
532 ; (ctxt', fvs1) <- rnTyKiContext env lctxt
533 ; (tau', fvs2) <- rnLHsTyKi env tau
534 ; return (HsQualTy { hst_xqual = noExt, hst_ctxt = ctxt'
535 , hst_body = tau' }
536 , fvs1 `plusFV` fvs2) }
537
538 rnHsTyKi env (HsTyVar _ ip (dL->L loc rdr_name))
539 = do { when (isRnKindLevel env && isRdrTyVar rdr_name) $
540 unlessXOptM LangExt.PolyKinds $ addErr $
541 withHsDocContext (rtke_ctxt env) $
542 vcat [ text "Unexpected kind variable" <+> quotes (ppr rdr_name)
543 , text "Perhaps you intended to use PolyKinds" ]
544 -- Any type variable at the kind level is illegal without the use
545 -- of PolyKinds (see #14710)
546 ; name <- rnTyVar env rdr_name
547 ; return (HsTyVar noExt ip (cL loc name), unitFV name) }
548
549 rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2)
550 = setSrcSpan (getLoc l_op) $
551 do { (l_op', fvs1) <- rnHsTyOp env ty l_op
552 ; fix <- lookupTyFixityRn l_op'
553 ; (ty1', fvs2) <- rnLHsTyKi env ty1
554 ; (ty2', fvs3) <- rnLHsTyKi env ty2
555 ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExt t1 l_op' t2)
556 (unLoc l_op') fix ty1' ty2'
557 ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) }
558
559 rnHsTyKi env (HsParTy _ ty)
560 = do { (ty', fvs) <- rnLHsTyKi env ty
561 ; return (HsParTy noExt ty', fvs) }
562
563 rnHsTyKi env (HsBangTy _ b ty)
564 = do { (ty', fvs) <- rnLHsTyKi env ty
565 ; return (HsBangTy noExt b ty', fvs) }
566
567 rnHsTyKi env ty@(HsRecTy _ flds)
568 = do { let ctxt = rtke_ctxt env
569 ; fls <- get_fields ctxt
570 ; (flds', fvs) <- rnConDeclFields ctxt fls flds
571 ; return (HsRecTy noExt flds', fvs) }
572 where
573 get_fields (ConDeclCtx names)
574 = concatMapM (lookupConstructorFields . unLoc) names
575 get_fields _
576 = do { addErr (hang (text "Record syntax is illegal here:")
577 2 (ppr ty))
578 ; return [] }
579
580 rnHsTyKi env (HsFunTy _ ty1 ty2)
581 = do { (ty1', fvs1) <- rnLHsTyKi env ty1
582 -- Might find a for-all as the arg of a function type
583 ; (ty2', fvs2) <- rnLHsTyKi env ty2
584 -- Or as the result. This happens when reading Prelude.hi
585 -- when we find return :: forall m. Monad m -> forall a. a -> m a
586
587 -- Check for fixity rearrangements
588 ; res_ty <- mkHsOpTyRn (HsFunTy noExt) funTyConName funTyFixity ty1' ty2'
589 ; return (res_ty, fvs1 `plusFV` fvs2) }
590
591 rnHsTyKi env listTy@(HsListTy _ ty)
592 = do { data_kinds <- xoptM LangExt.DataKinds
593 ; when (not data_kinds && isRnKindLevel env)
594 (addErr (dataKindsErr env listTy))
595 ; (ty', fvs) <- rnLHsTyKi env ty
596 ; return (HsListTy noExt ty', fvs) }
597
598 rnHsTyKi env t@(HsKindSig _ ty k)
599 = do { checkPolyKinds env t
600 ; kind_sigs_ok <- xoptM LangExt.KindSignatures
601 ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty)
602 ; (ty', fvs1) <- rnLHsTyKi env ty
603 ; (k', fvs2) <- rnLHsTyKi (env { rtke_level = KindLevel }) k
604 ; return (HsKindSig noExt ty' k', fvs1 `plusFV` fvs2) }
605
606 -- Unboxed tuples are allowed to have poly-typed arguments. These
607 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
608 rnHsTyKi env tupleTy@(HsTupleTy _ tup_con tys)
609 = do { data_kinds <- xoptM LangExt.DataKinds
610 ; when (not data_kinds && isRnKindLevel env)
611 (addErr (dataKindsErr env tupleTy))
612 ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
613 ; return (HsTupleTy noExt tup_con tys', fvs) }
614
615 rnHsTyKi env sumTy@(HsSumTy _ tys)
616 = do { data_kinds <- xoptM LangExt.DataKinds
617 ; when (not data_kinds && isRnKindLevel env)
618 (addErr (dataKindsErr env sumTy))
619 ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
620 ; return (HsSumTy noExt tys', fvs) }
621
622 -- Ensure that a type-level integer is nonnegative (#8306, #8412)
623 rnHsTyKi env tyLit@(HsTyLit _ t)
624 = do { data_kinds <- xoptM LangExt.DataKinds
625 ; unless data_kinds (addErr (dataKindsErr env tyLit))
626 ; when (negLit t) (addErr negLitErr)
627 ; checkPolyKinds env tyLit
628 ; return (HsTyLit noExt t, emptyFVs) }
629 where
630 negLit (HsStrTy _ _) = False
631 negLit (HsNumTy _ i) = i < 0
632 negLitErr = text "Illegal literal in type (type literals must not be negative):" <+> ppr tyLit
633
634 rnHsTyKi env (HsAppTy _ ty1 ty2)
635 = do { (ty1', fvs1) <- rnLHsTyKi env ty1
636 ; (ty2', fvs2) <- rnLHsTyKi env ty2
637 ; return (HsAppTy noExt ty1' ty2', fvs1 `plusFV` fvs2) }
638
639 rnHsTyKi env (HsAppKindTy _ ty k)
640 = do { kind_app <- xoptM LangExt.TypeApplications
641 ; unless kind_app (addErr (typeAppErr "kind" k))
642 ; (ty', fvs1) <- rnLHsTyKi env ty
643 ; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k
644 ; return (HsAppKindTy noExt ty' k', fvs1 `plusFV` fvs2) }
645
646 rnHsTyKi env t@(HsIParamTy _ n ty)
647 = do { notInKinds env t
648 ; (ty', fvs) <- rnLHsTyKi env ty
649 ; return (HsIParamTy noExt n ty', fvs) }
650
651 rnHsTyKi _ (HsStarTy _ isUni)
652 = return (HsStarTy noExt isUni, emptyFVs)
653
654 rnHsTyKi _ (HsSpliceTy _ sp)
655 = rnSpliceType sp
656
657 rnHsTyKi env (HsDocTy _ ty haddock_doc)
658 = do { (ty', fvs) <- rnLHsTyKi env ty
659 ; haddock_doc' <- rnLHsDoc haddock_doc
660 ; return (HsDocTy noExt ty' haddock_doc', fvs) }
661
662 rnHsTyKi _ (XHsType (NHsCoreTy ty))
663 = return (XHsType (NHsCoreTy ty), emptyFVs)
664 -- The emptyFVs probably isn't quite right
665 -- but I don't think it matters
666
667 rnHsTyKi env ty@(HsExplicitListTy _ ip tys)
668 = do { checkPolyKinds env ty
669 ; data_kinds <- xoptM LangExt.DataKinds
670 ; unless data_kinds (addErr (dataKindsErr env ty))
671 ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
672 ; return (HsExplicitListTy noExt ip tys', fvs) }
673
674 rnHsTyKi env ty@(HsExplicitTupleTy _ tys)
675 = do { checkPolyKinds env ty
676 ; data_kinds <- xoptM LangExt.DataKinds
677 ; unless data_kinds (addErr (dataKindsErr env ty))
678 ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
679 ; return (HsExplicitTupleTy noExt tys', fvs) }
680
681 rnHsTyKi env (HsWildCardTy _)
682 = do { checkAnonWildCard env
683 ; return (HsWildCardTy noExt, emptyFVs) }
684
685 --------------
686 rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name
687 rnTyVar env rdr_name
688 = do { name <- lookupTypeOccRn rdr_name
689 ; checkNamedWildCard env name
690 ; return name }
691
692 rnLTyVar :: Located RdrName -> RnM (Located Name)
693 -- Called externally; does not deal with wildards
694 rnLTyVar (dL->L loc rdr_name)
695 = do { tyvar <- lookupTypeOccRn rdr_name
696 ; return (cL loc tyvar) }
697
698 --------------
699 rnHsTyOp :: Outputable a
700 => RnTyKiEnv -> a -> Located RdrName
701 -> RnM (Located Name, FreeVars)
702 rnHsTyOp env overall_ty (dL->L loc op)
703 = do { ops_ok <- xoptM LangExt.TypeOperators
704 ; op' <- rnTyVar env op
705 ; unless (ops_ok || op' `hasKey` eqTyConKey) $
706 addErr (opTyErr op overall_ty)
707 ; let l_op' = cL loc op'
708 ; return (l_op', unitFV op') }
709
710 --------------
711 notAllowed :: SDoc -> SDoc
712 notAllowed doc
713 = text "Wildcard" <+> quotes doc <+> ptext (sLit "not allowed")
714
715 checkWildCard :: RnTyKiEnv -> Maybe SDoc -> RnM ()
716 checkWildCard env (Just doc)
717 = addErr $ vcat [doc, nest 2 (text "in" <+> pprHsDocContext (rtke_ctxt env))]
718 checkWildCard _ Nothing
719 = return ()
720
721 checkAnonWildCard :: RnTyKiEnv -> RnM ()
722 -- Report an error if an anonymous wildcard is illegal here
723 checkAnonWildCard env
724 = checkWildCard env mb_bad
725 where
726 mb_bad :: Maybe SDoc
727 mb_bad | not (wildCardsAllowed env)
728 = Just (notAllowed pprAnonWildCard)
729 | otherwise
730 = case rtke_what env of
731 RnTypeBody -> Nothing
732 RnConstraint -> Just constraint_msg
733 RnTopConstraint -> Just constraint_msg
734
735 constraint_msg = hang
736 (notAllowed pprAnonWildCard <+> text "in a constraint")
737 2 hint_msg
738 hint_msg = vcat [ text "except as the last top-level constraint of a type signature"
739 , nest 2 (text "e.g f :: (Eq a, _) => blah") ]
740
741 checkNamedWildCard :: RnTyKiEnv -> Name -> RnM ()
742 -- Report an error if a named wildcard is illegal here
743 checkNamedWildCard env name
744 = checkWildCard env mb_bad
745 where
746 mb_bad | not (name `elemNameSet` rtke_nwcs env)
747 = Nothing -- Not a wildcard
748 | not (wildCardsAllowed env)
749 = Just (notAllowed (ppr name))
750 | otherwise
751 = case rtke_what env of
752 RnTypeBody -> Nothing -- Allowed
753 RnTopConstraint -> Nothing -- Allowed
754 RnConstraint -> Just constraint_msg
755 constraint_msg = notAllowed (ppr name) <+> text "in a constraint"
756
757 wildCardsAllowed :: RnTyKiEnv -> Bool
758 -- ^ In what contexts are wildcards permitted
759 wildCardsAllowed env
760 = case rtke_ctxt env of
761 TypeSigCtx {} -> True
762 TypBrCtx {} -> True -- Template Haskell quoted type
763 SpliceTypeCtx {} -> True -- Result of a Template Haskell splice
764 ExprWithTySigCtx {} -> True
765 PatCtx {} -> True
766 RuleCtx {} -> True
767 FamPatCtx {} -> True -- Not named wildcards though
768 GHCiCtx {} -> True
769 HsTypeCtx {} -> True
770 _ -> False
771
772
773
774 ---------------
775 -- | Ensures either that we're in a type or that -XPolyKinds is set
776 checkPolyKinds :: Outputable ty
777 => RnTyKiEnv
778 -> ty -- ^ type
779 -> RnM ()
780 checkPolyKinds env ty
781 | isRnKindLevel env
782 = do { polykinds <- xoptM LangExt.PolyKinds
783 ; unless polykinds $
784 addErr (text "Illegal kind:" <+> ppr ty $$
785 text "Did you mean to enable PolyKinds?") }
786 checkPolyKinds _ _ = return ()
787
788 notInKinds :: Outputable ty
789 => RnTyKiEnv
790 -> ty
791 -> RnM ()
792 notInKinds env ty
793 | isRnKindLevel env
794 = addErr (text "Illegal kind:" <+> ppr ty)
795 notInKinds _ _ = return ()
796
797 {- *****************************************************
798 * *
799 Binding type variables
800 * *
801 ***************************************************** -}
802
803 bindSigTyVarsFV :: [Name]
804 -> RnM (a, FreeVars)
805 -> RnM (a, FreeVars)
806 -- Used just before renaming the defn of a function
807 -- with a separate type signature, to bring its tyvars into scope
808 -- With no -XScopedTypeVariables, this is a no-op
809 bindSigTyVarsFV tvs thing_inside
810 = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables
811 ; if not scoped_tyvars then
812 thing_inside
813 else
814 bindLocalNamesFV tvs thing_inside }
815
816 -- | Simply bring a bunch of RdrNames into scope. No checking for
817 -- validity, at all. The binding location is taken from the location
818 -- on each name.
819 bindLRdrNames :: [Located RdrName]
820 -> ([Name] -> RnM (a, FreeVars))
821 -> RnM (a, FreeVars)
822 bindLRdrNames rdrs thing_inside
823 = do { var_names <- mapM (newTyVarNameRn Nothing) rdrs
824 ; bindLocalNamesFV var_names $
825 thing_inside var_names }
826
827 ---------------
828 bindHsQTyVars :: forall a b.
829 HsDocContext
830 -> Maybe SDoc -- Just d => check for unused tvs
831 -- d is a phrase like "in the type ..."
832 -> Maybe a -- Just _ => an associated type decl
833 -> [Located RdrName] -- Kind variables from scope, no dups
834 -> (LHsQTyVars GhcPs)
835 -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars))
836 -- The Bool is True <=> all kind variables used in the
837 -- kind signature are bound on the left. Reason:
838 -- the last clause of Note [CUSKs: Complete user-supplied
839 -- kind signatures] in HsDecls
840 -> RnM (b, FreeVars)
841
842 -- See Note [bindHsQTyVars examples]
843 -- (a) Bring kind variables into scope
844 -- both (i) passed in body_kv_occs
845 -- and (ii) mentioned in the kinds of hsq_bndrs
846 -- (b) Bring type variables into scope
847 --
848 bindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside
849 = do { let hs_tv_bndrs = hsQTvExplicit hsq_bndrs
850 bndr_kv_occs = extractHsTyVarBndrsKVs hs_tv_bndrs
851
852 ; let -- See Note [bindHsQTyVars examples] for what
853 -- all these various things are doing
854 bndrs, kv_occs, implicit_kvs :: [Located RdrName]
855 bndrs = map hsLTyVarLocName hs_tv_bndrs
856 kv_occs = nubL (bndr_kv_occs ++ body_kv_occs)
857 -- Make sure to list the binder kvs before the
858 -- body kvs, as mandated by
859 -- Note [Ordering of implicit variables]
860 implicit_kvs = filter_occs bndrs kv_occs
861 -- dep_bndrs is the subset of bndrs that are dependent
862 -- i.e. appear in bndr/body_kv_occs
863 -- Can't use implicit_kvs because we've deleted bndrs from that!
864 dep_bndrs = filter (`elemRdr` kv_occs) bndrs
865 del = deleteBys eqLocated
866 all_bound_on_lhs = null ((body_kv_occs `del` bndrs) `del` bndr_kv_occs)
867
868 ; traceRn "checkMixedVars3" $
869 vcat [ text "kv_occs" <+> ppr kv_occs
870 , text "bndrs" <+> ppr hs_tv_bndrs
871 , text "bndr_kv_occs" <+> ppr bndr_kv_occs
872 , text "wubble" <+> ppr ((kv_occs \\ bndrs) \\ bndr_kv_occs)
873 ]
874
875 ; implicit_kv_nms <- mapM (newTyVarNameRn mb_assoc) implicit_kvs
876
877 ; bindLocalNamesFV implicit_kv_nms $
878 bindLHsTyVarBndrs doc mb_in_doc mb_assoc hs_tv_bndrs $ \ rn_bndrs ->
879 do { traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs)
880 ; dep_bndr_nms <- mapM (lookupLocalOccRn . unLoc) dep_bndrs
881 ; thing_inside (HsQTvs { hsq_ext = HsQTvsRn
882 { hsq_implicit = implicit_kv_nms
883 , hsq_dependent = mkNameSet dep_bndr_nms }
884 , hsq_explicit = rn_bndrs })
885 all_bound_on_lhs } }
886
887 where
888 filter_occs :: [Located RdrName] -- Bound here
889 -> [Located RdrName] -- Potential implicit binders
890 -> [Located RdrName] -- Final implicit binders
891 -- Filter out any potential implicit binders that are either
892 -- already in scope, or are explicitly bound in the same HsQTyVars
893 filter_occs bndrs occs
894 = filterOut is_in_scope occs
895 where
896 is_in_scope locc = locc `elemRdr` bndrs
897
898 {- Note [bindHsQTyVars examples]
899 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
900 Suppose we have
901 data T k (a::k1) (b::k) :: k2 -> k1 -> *
902
903 Then:
904 hs_tv_bndrs = [k, a::k1, b::k], the explicitly-bound variables
905 bndrs = [k,a,b]
906
907 bndr_kv_occs = [k,k1], kind variables free in kind signatures
908 of hs_tv_bndrs
909
910 body_kv_occs = [k2,k1], kind variables free in the
911 result kind signature
912
913 implicit_kvs = [k1,k2], kind variables free in kind signatures
914 of hs_tv_bndrs, and not bound by bndrs
915
916 * We want to quantify add implicit bindings for implicit_kvs
917
918 * The "dependent" bndrs (hsq_dependent) are the subset of
919 bndrs that are free in bndr_kv_occs or body_kv_occs
920
921 * If implicit_body_kvs is non-empty, then there is a kind variable
922 mentioned in the kind signature that is not bound "on the left".
923 That's one of the rules for a CUSK, so we pass that info on
924 as the second argument to thing_inside.
925
926 * Order is not important in these lists. All we are doing is
927 bring Names into scope.
928
929 Finally, you may wonder why filter_occs removes in-scope variables
930 from bndr/body_kv_occs. How can anything be in scope? Answer:
931 HsQTyVars is /also/ used (slightly oddly) for Haskell-98 syntax
932 ConDecls
933 data T a = forall (b::k). MkT a b
934 The ConDecl has a LHsQTyVars in it; but 'a' scopes over the entire
935 ConDecl. Hence the local RdrEnv may be non-empty and we must filter
936 out 'a' from the free vars. (Mind you, in this situation all the
937 implicit kind variables are bound at the data type level, so there
938 are none to bind in the ConDecl, so there are no implicitly bound
939 variables at all.
940
941 Note [Kind variable scoping]
942 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
943 If we have
944 data T (a :: k) k = ...
945 we report "k is out of scope" for (a::k). Reason: k is not brought
946 into scope until the explicit k-binding that follows. It would be
947 terribly confusing to bring into scope an /implicit/ k for a's kind
948 and a distinct, shadowing explicit k that follows, something like
949 data T {k1} (a :: k1) k = ...
950
951 So the rule is:
952
953 the implicit binders never include any
954 of the explicit binders in the group
955
956 Note that in the denerate case
957 data T (a :: a) = blah
958 we get a complaint the second 'a' is not in scope.
959
960 That applies to foralls too: e.g.
961 forall (a :: k) k . blah
962
963 But if the foralls are split, we treat the two groups separately:
964 forall (a :: k). forall k. blah
965 Here we bring into scope an implicit k, which is later shadowed
966 by the explicit k.
967
968 In implementation terms
969
970 * In bindHsQTyVars 'k' is free in bndr_kv_occs; then we delete
971 the binders {a,k}, and so end with no implicit binders. Then we
972 rename the binders left-to-right, and hence see that 'k' is out of
973 scope in the kind of 'a'.
974
975 * Similarly in extract_hs_tv_bndrs
976
977 Note [Variables used as both types and kinds]
978 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
979 We bind the type variables tvs, and kvs is the set of free variables of the
980 kinds in the scope of the binding. Here is one typical example:
981
982 forall a b. a -> (b::k) -> (c::a)
983
984 Here, tvs will be {a,b}, and kvs {k,a}.
985
986 We must make sure that kvs includes all of variables in the kinds of type
987 variable bindings. For instance:
988
989 forall k (a :: k). Proxy a
990
991 If we only look in the body of the `forall` type, we will mistakenly conclude
992 that kvs is {}. But in fact, the type variable `k` is also used as a kind
993 variable in (a :: k), later in the binding. (This mistake lead to #14710.)
994 So tvs is {k,a} and kvs is {k}.
995
996 NB: we do this only at the binding site of 'tvs'.
997 -}
998
999 bindLHsTyVarBndrs :: HsDocContext
1000 -> Maybe SDoc -- Just d => check for unused tvs
1001 -- d is a phrase like "in the type ..."
1002 -> Maybe a -- Just _ => an associated type decl
1003 -> [LHsTyVarBndr GhcPs] -- User-written tyvars
1004 -> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars))
1005 -> RnM (b, FreeVars)
1006 bindLHsTyVarBndrs doc mb_in_doc mb_assoc tv_bndrs thing_inside
1007 = do { when (isNothing mb_assoc) (checkShadowedRdrNames tv_names_w_loc)
1008 ; checkDupRdrNames tv_names_w_loc
1009 ; go tv_bndrs thing_inside }
1010 where
1011 tv_names_w_loc = map hsLTyVarLocName tv_bndrs
1012
1013 go [] thing_inside = thing_inside []
1014 go (b:bs) thing_inside = bindLHsTyVarBndr doc mb_assoc b $ \ b' ->
1015 do { (res, fvs) <- go bs $ \ bs' ->
1016 thing_inside (b' : bs')
1017 ; warn_unused b' fvs
1018 ; return (res, fvs) }
1019
1020 warn_unused tv_bndr fvs = case mb_in_doc of
1021 Just in_doc -> warnUnusedForAll in_doc tv_bndr fvs
1022 Nothing -> return ()
1023
1024 bindLHsTyVarBndr :: HsDocContext
1025 -> Maybe a -- associated class
1026 -> LHsTyVarBndr GhcPs
1027 -> (LHsTyVarBndr GhcRn -> RnM (b, FreeVars))
1028 -> RnM (b, FreeVars)
1029 bindLHsTyVarBndr _doc mb_assoc (dL->L loc
1030 (UserTyVar x
1031 lrdr@(dL->L lv _))) thing_inside
1032 = do { nm <- newTyVarNameRn mb_assoc lrdr
1033 ; bindLocalNamesFV [nm] $
1034 thing_inside (cL loc (UserTyVar x (cL lv nm))) }
1035
1036 bindLHsTyVarBndr doc mb_assoc (dL->L loc (KindedTyVar x lrdr@(dL->L lv _) kind))
1037 thing_inside
1038 = do { sig_ok <- xoptM LangExt.KindSignatures
1039 ; unless sig_ok (badKindSigErr doc kind)
1040 ; (kind', fvs1) <- rnLHsKind doc kind
1041 ; tv_nm <- newTyVarNameRn mb_assoc lrdr
1042 ; (b, fvs2) <- bindLocalNamesFV [tv_nm]
1043 $ thing_inside (cL loc (KindedTyVar x (cL lv tv_nm) kind'))
1044 ; return (b, fvs1 `plusFV` fvs2) }
1045
1046 bindLHsTyVarBndr _ _ (dL->L _ (XTyVarBndr{})) _ = panic "bindLHsTyVarBndr"
1047 bindLHsTyVarBndr _ _ _ _ = panic "bindLHsTyVarBndr: Impossible Match"
1048 -- due to #15884
1049
1050 newTyVarNameRn :: Maybe a -> Located RdrName -> RnM Name
1051 newTyVarNameRn mb_assoc (dL->L loc rdr)
1052 = do { rdr_env <- getLocalRdrEnv
1053 ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of
1054 (Just _, Just n) -> return n
1055 -- Use the same Name as the parent class decl
1056
1057 _ -> newLocalBndrRn (cL loc rdr) }
1058 {-
1059 *********************************************************
1060 * *
1061 ConDeclField
1062 * *
1063 *********************************************************
1064
1065 When renaming a ConDeclField, we have to find the FieldLabel
1066 associated with each field. But we already have all the FieldLabels
1067 available (since they were brought into scope by
1068 RnNames.getLocalNonValBinders), so we just take the list as an
1069 argument, build a map and look them up.
1070 -}
1071
1072 rnConDeclFields :: HsDocContext -> [FieldLabel] -> [LConDeclField GhcPs]
1073 -> RnM ([LConDeclField GhcRn], FreeVars)
1074 -- Also called from RnSource
1075 -- No wildcards can appear in record fields
1076 rnConDeclFields ctxt fls fields
1077 = mapFvRn (rnField fl_env env) fields
1078 where
1079 env = mkTyKiEnv ctxt TypeLevel RnTypeBody
1080 fl_env = mkFsEnv [ (flLabel fl, fl) | fl <- fls ]
1081
1082 rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField GhcPs
1083 -> RnM (LConDeclField GhcRn, FreeVars)
1084 rnField fl_env env (dL->L l (ConDeclField _ names ty haddock_doc))
1085 = do { let new_names = map (fmap lookupField) names
1086 ; (new_ty, fvs) <- rnLHsTyKi env ty
1087 ; new_haddock_doc <- rnMbLHsDoc haddock_doc
1088 ; return (cL l (ConDeclField noExt new_names new_ty new_haddock_doc)
1089 , fvs) }
1090 where
1091 lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn
1092 lookupField (FieldOcc _ (dL->L lr rdr)) =
1093 FieldOcc (flSelector fl) (cL lr rdr)
1094 where
1095 lbl = occNameFS $ rdrNameOcc rdr
1096 fl = expectJust "rnField" $ lookupFsEnv fl_env lbl
1097 lookupField (XFieldOcc{}) = panic "rnField"
1098 rnField _ _ (dL->L _ (XConDeclField _)) = panic "rnField"
1099 rnField _ _ _ = panic "rnField: Impossible Match"
1100 -- due to #15884
1101
1102 {-
1103 ************************************************************************
1104 * *
1105 Fixities and precedence parsing
1106 * *
1107 ************************************************************************
1108
1109 @mkOpAppRn@ deals with operator fixities. The argument expressions
1110 are assumed to be already correctly arranged. It needs the fixities
1111 recorded in the OpApp nodes, because fixity info applies to the things
1112 the programmer actually wrote, so you can't find it out from the Name.
1113
1114 Furthermore, the second argument is guaranteed not to be another
1115 operator application. Why? Because the parser parses all
1116 operator applications left-associatively, EXCEPT negation, which
1117 we need to handle specially.
1118 Infix types are read in a *right-associative* way, so that
1119 a `op` b `op` c
1120 is always read in as
1121 a `op` (b `op` c)
1122
1123 mkHsOpTyRn rearranges where necessary. The two arguments
1124 have already been renamed and rearranged. It's made rather tiresome
1125 by the presence of ->, which is a separate syntactic construct.
1126 -}
1127
1128 ---------------
1129 -- Building (ty1 `op1` (ty21 `op2` ty22))
1130 mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
1131 -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn
1132 -> RnM (HsType GhcRn)
1133
1134 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsOpTy noExt ty21 op2 ty22))
1135 = do { fix2 <- lookupTyFixityRn op2
1136 ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
1137 (\t1 t2 -> HsOpTy noExt t1 op2 t2)
1138 (unLoc op2) fix2 ty21 ty22 loc2 }
1139
1140 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsFunTy _ ty21 ty22))
1141 = mk_hs_op_ty mk1 pp_op1 fix1 ty1
1142 (HsFunTy noExt) funTyConName funTyFixity ty21 ty22 loc2
1143
1144 mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment
1145 = return (mk1 ty1 ty2)
1146
1147 ---------------
1148 mk_hs_op_ty :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
1149 -> Name -> Fixity -> LHsType GhcRn
1150 -> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
1151 -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> SrcSpan
1152 -> RnM (HsType GhcRn)
1153 mk_hs_op_ty mk1 op1 fix1 ty1
1154 mk2 op2 fix2 ty21 ty22 loc2
1155 | nofix_error = do { precParseErr (NormalOp op1,fix1) (NormalOp op2,fix2)
1156 ; return (mk1 ty1 (cL loc2 (mk2 ty21 ty22))) }
1157 | associate_right = return (mk1 ty1 (cL loc2 (mk2 ty21 ty22)))
1158 | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
1159 new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21
1160 ; return (mk2 (noLoc new_ty) ty22) }
1161 where
1162 (nofix_error, associate_right) = compareFixity fix1 fix2
1163
1164
1165 ---------------------------
1166 mkOpAppRn :: LHsExpr GhcRn -- Left operand; already rearranged
1167 -> LHsExpr GhcRn -> Fixity -- Operator and fixity
1168 -> LHsExpr GhcRn -- Right operand (not an OpApp, but might
1169 -- be a NegApp)
1170 -> RnM (HsExpr GhcRn)
1171
1172 -- (e11 `op1` e12) `op2` e2
1173 mkOpAppRn e1@(dL->L _ (OpApp fix1 e11 op1 e12)) op2 fix2 e2
1174 | nofix_error
1175 = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
1176 return (OpApp fix2 e1 op2 e2)
1177
1178 | associate_right = do
1179 new_e <- mkOpAppRn e12 op2 fix2 e2
1180 return (OpApp fix1 e11 op1 (cL loc' new_e))
1181 where
1182 loc'= combineLocs e12 e2
1183 (nofix_error, associate_right) = compareFixity fix1 fix2
1184
1185 ---------------------------
1186 -- (- neg_arg) `op` e2
1187 mkOpAppRn e1@(dL->L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2
1188 | nofix_error
1189 = do precParseErr (NegateOp,negateFixity) (get_op op2,fix2)
1190 return (OpApp fix2 e1 op2 e2)
1191
1192 | associate_right
1193 = do new_e <- mkOpAppRn neg_arg op2 fix2 e2
1194 return (NegApp noExt (cL loc' new_e) neg_name)
1195 where
1196 loc' = combineLocs neg_arg e2
1197 (nofix_error, associate_right) = compareFixity negateFixity fix2
1198
1199 ---------------------------
1200 -- e1 `op` - neg_arg
1201 mkOpAppRn e1 op1 fix1 e2@(dL->L _ (NegApp {})) -- NegApp can occur on the right
1202 | not associate_right -- We *want* right association
1203 = do precParseErr (get_op op1, fix1) (NegateOp, negateFixity)
1204 return (OpApp fix1 e1 op1 e2)
1205 where
1206 (_, associate_right) = compareFixity fix1 negateFixity
1207
1208 ---------------------------
1209 -- Default case
1210 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
1211 = ASSERT2( right_op_ok fix (unLoc e2),
1212 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
1213 )
1214 return (OpApp fix e1 op e2)
1215
1216 ----------------------------
1217
1218 -- | Name of an operator in an operator application or section
1219 data OpName = NormalOp Name -- ^ A normal identifier
1220 | NegateOp -- ^ Prefix negation
1221 | UnboundOp UnboundVar -- ^ An unbound indentifier
1222 | RecFldOp (AmbiguousFieldOcc GhcRn)
1223 -- ^ A (possibly ambiguous) record field occurrence
1224
1225 instance Outputable OpName where
1226 ppr (NormalOp n) = ppr n
1227 ppr NegateOp = ppr negateName
1228 ppr (UnboundOp uv) = ppr uv
1229 ppr (RecFldOp fld) = ppr fld
1230
1231 get_op :: LHsExpr GhcRn -> OpName
1232 -- An unbound name could be either HsVar or HsUnboundVar
1233 -- See RnExpr.rnUnboundVar
1234 get_op (dL->L _ (HsVar _ n)) = NormalOp (unLoc n)
1235 get_op (dL->L _ (HsUnboundVar _ uv)) = UnboundOp uv
1236 get_op (dL->L _ (HsRecFld _ fld)) = RecFldOp fld
1237 get_op other = pprPanic "get_op" (ppr other)
1238
1239 -- Parser left-associates everything, but
1240 -- derived instances may have correctly-associated things to
1241 -- in the right operand. So we just check that the right operand is OK
1242 right_op_ok :: Fixity -> HsExpr GhcRn -> Bool
1243 right_op_ok fix1 (OpApp fix2 _ _ _)
1244 = not error_please && associate_right
1245 where
1246 (error_please, associate_right) = compareFixity fix1 fix2
1247 right_op_ok _ _
1248 = True
1249
1250 -- Parser initially makes negation bind more tightly than any other operator
1251 -- And "deriving" code should respect this (use HsPar if not)
1252 mkNegAppRn :: LHsExpr (GhcPass id) -> SyntaxExpr (GhcPass id)
1253 -> RnM (HsExpr (GhcPass id))
1254 mkNegAppRn neg_arg neg_name
1255 = ASSERT( not_op_app (unLoc neg_arg) )
1256 return (NegApp noExt neg_arg neg_name)
1257
1258 not_op_app :: HsExpr id -> Bool
1259 not_op_app (OpApp {}) = False
1260 not_op_app _ = True
1261
1262 ---------------------------
1263 mkOpFormRn :: LHsCmdTop GhcRn -- Left operand; already rearranged
1264 -> LHsExpr GhcRn -> Fixity -- Operator and fixity
1265 -> LHsCmdTop GhcRn -- Right operand (not an infix)
1266 -> RnM (HsCmd GhcRn)
1267
1268 -- (e11 `op1` e12) `op2` e2
1269 mkOpFormRn a1@(dL->L loc
1270 (HsCmdTop _
1271 (dL->L _ (HsCmdArrForm x op1 f (Just fix1)
1272 [a11,a12]))))
1273 op2 fix2 a2
1274 | nofix_error
1275 = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
1276 return (HsCmdArrForm x op2 f (Just fix2) [a1, a2])
1277
1278 | associate_right
1279 = do new_c <- mkOpFormRn a12 op2 fix2 a2
1280 return (HsCmdArrForm noExt op1 f (Just fix1)
1281 [a11, cL loc (HsCmdTop [] (cL loc new_c))])
1282 -- TODO: locs are wrong
1283 where
1284 (nofix_error, associate_right) = compareFixity fix1 fix2
1285
1286 -- Default case
1287 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
1288 = return (HsCmdArrForm noExt op Infix (Just fix) [arg1, arg2])
1289
1290
1291 --------------------------------------
1292 mkConOpPatRn :: Located Name -> Fixity -> LPat GhcRn -> LPat GhcRn
1293 -> RnM (Pat GhcRn)
1294
1295 mkConOpPatRn op2 fix2 p1@(dL->L loc (ConPatIn op1 (InfixCon p11 p12))) p2
1296 = do { fix1 <- lookupFixityRn (unLoc op1)
1297 ; let (nofix_error, associate_right) = compareFixity fix1 fix2
1298
1299 ; if nofix_error then do
1300 { precParseErr (NormalOp (unLoc op1),fix1)
1301 (NormalOp (unLoc op2),fix2)
1302 ; return (ConPatIn op2 (InfixCon p1 p2)) }
1303
1304 else if associate_right then do
1305 { new_p <- mkConOpPatRn op2 fix2 p12 p2
1306 ; return (ConPatIn op1 (InfixCon p11 (cL loc new_p))) }
1307 -- XXX loc right?
1308 else return (ConPatIn op2 (InfixCon p1 p2)) }
1309
1310 mkConOpPatRn op _ p1 p2 -- Default case, no rearrangment
1311 = ASSERT( not_op_pat (unLoc p2) )
1312 return (ConPatIn op (InfixCon p1 p2))
1313
1314 not_op_pat :: Pat GhcRn -> Bool
1315 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
1316 not_op_pat _ = True
1317
1318 --------------------------------------
1319 checkPrecMatch :: Name -> MatchGroup GhcRn body -> RnM ()
1320 -- Check precedence of a function binding written infix
1321 -- eg a `op` b `C` c = ...
1322 -- See comments with rnExpr (OpApp ...) about "deriving"
1323
1324 checkPrecMatch op (MG { mg_alts = (dL->L _ ms) })
1325 = mapM_ check ms
1326 where
1327 check (dL->L _ (Match { m_pats = (dL->L l1 p1)
1328 : (dL->L l2 p2)
1329 : _ }))
1330 = setSrcSpan (combineSrcSpans l1 l2) $
1331 do checkPrec op p1 False
1332 checkPrec op p2 True
1333
1334 check _ = return ()
1335 -- This can happen. Consider
1336 -- a `op` True = ...
1337 -- op = ...
1338 -- The infix flag comes from the first binding of the group
1339 -- but the second eqn has no args (an error, but not discovered
1340 -- until the type checker). So we don't want to crash on the
1341 -- second eqn.
1342 checkPrecMatch _ (XMatchGroup {}) = panic "checkPrecMatch"
1343
1344 checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
1345 checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
1346 op_fix@(Fixity _ op_prec op_dir) <- lookupFixityRn op
1347 op1_fix@(Fixity _ op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
1348 let
1349 inf_ok = op1_prec > op_prec ||
1350 (op1_prec == op_prec &&
1351 (op1_dir == InfixR && op_dir == InfixR && right ||
1352 op1_dir == InfixL && op_dir == InfixL && not right))
1353
1354 info = (NormalOp op, op_fix)
1355 info1 = (NormalOp (unLoc op1), op1_fix)
1356 (infol, infor) = if right then (info, info1) else (info1, info)
1357 unless inf_ok (precParseErr infol infor)
1358
1359 checkPrec _ _ _
1360 = return ()
1361
1362 -- Check precedence of (arg op) or (op arg) respectively
1363 -- If arg is itself an operator application, then either
1364 -- (a) its precedence must be higher than that of op
1365 -- (b) its precedency & associativity must be the same as that of op
1366 checkSectionPrec :: FixityDirection -> HsExpr GhcPs
1367 -> LHsExpr GhcRn -> LHsExpr GhcRn -> RnM ()
1368 checkSectionPrec direction section op arg
1369 = case unLoc arg of
1370 OpApp fix _ op' _ -> go_for_it (get_op op') fix
1371 NegApp _ _ _ -> go_for_it NegateOp negateFixity
1372 _ -> return ()
1373 where
1374 op_name = get_op op
1375 go_for_it arg_op arg_fix@(Fixity _ arg_prec assoc) = do
1376 op_fix@(Fixity _ op_prec _) <- lookupFixityOp op_name
1377 unless (op_prec < arg_prec
1378 || (op_prec == arg_prec && direction == assoc))
1379 (sectionPrecErr (get_op op, op_fix)
1380 (arg_op, arg_fix) section)
1381
1382 -- | Look up the fixity for an operator name. Be careful to use
1383 -- 'lookupFieldFixityRn' for (possibly ambiguous) record fields
1384 -- (see Trac #13132).
1385 lookupFixityOp :: OpName -> RnM Fixity
1386 lookupFixityOp (NormalOp n) = lookupFixityRn n
1387 lookupFixityOp NegateOp = lookupFixityRn negateName
1388 lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName (unboundVarOcc u))
1389 lookupFixityOp (RecFldOp f) = lookupFieldFixityRn f
1390
1391
1392 -- Precedence-related error messages
1393
1394 precParseErr :: (OpName,Fixity) -> (OpName,Fixity) -> RnM ()
1395 precParseErr op1@(n1,_) op2@(n2,_)
1396 | is_unbound n1 || is_unbound n2
1397 = return () -- Avoid error cascade
1398 | otherwise
1399 = addErr $ hang (text "Precedence parsing error")
1400 4 (hsep [text "cannot mix", ppr_opfix op1, ptext (sLit "and"),
1401 ppr_opfix op2,
1402 text "in the same infix expression"])
1403
1404 sectionPrecErr :: (OpName,Fixity) -> (OpName,Fixity) -> HsExpr GhcPs -> RnM ()
1405 sectionPrecErr op@(n1,_) arg_op@(n2,_) section
1406 | is_unbound n1 || is_unbound n2
1407 = return () -- Avoid error cascade
1408 | otherwise
1409 = addErr $ vcat [text "The operator" <+> ppr_opfix op <+> ptext (sLit "of a section"),
1410 nest 4 (sep [text "must have lower precedence than that of the operand,",
1411 nest 2 (text "namely" <+> ppr_opfix arg_op)]),
1412 nest 4 (text "in the section:" <+> quotes (ppr section))]
1413
1414 is_unbound :: OpName -> Bool
1415 is_unbound (NormalOp n) = isUnboundName n
1416 is_unbound UnboundOp{} = True
1417 is_unbound _ = False
1418
1419 ppr_opfix :: (OpName, Fixity) -> SDoc
1420 ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
1421 where
1422 pp_op | NegateOp <- op = text "prefix `-'"
1423 | otherwise = quotes (ppr op)
1424
1425
1426 {- *****************************************************
1427 * *
1428 Errors
1429 * *
1430 ***************************************************** -}
1431
1432 unexpectedTypeSigErr :: LHsSigWcType GhcPs -> SDoc
1433 unexpectedTypeSigErr ty
1434 = hang (text "Illegal type signature:" <+> quotes (ppr ty))
1435 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables")
1436
1437 badKindSigErr :: HsDocContext -> LHsType GhcPs -> TcM ()
1438 badKindSigErr doc (dL->L loc ty)
1439 = setSrcSpan loc $ addErr $
1440 withHsDocContext doc $
1441 hang (text "Illegal kind signature:" <+> quotes (ppr ty))
1442 2 (text "Perhaps you intended to use KindSignatures")
1443
1444 dataKindsErr :: RnTyKiEnv -> HsType GhcPs -> SDoc
1445 dataKindsErr env thing
1446 = hang (text "Illegal" <+> pp_what <> colon <+> quotes (ppr thing))
1447 2 (text "Perhaps you intended to use DataKinds")
1448 where
1449 pp_what | isRnKindLevel env = text "kind"
1450 | otherwise = text "type"
1451
1452 inTypeDoc :: HsType GhcPs -> SDoc
1453 inTypeDoc ty = text "In the type" <+> quotes (ppr ty)
1454
1455 warnUnusedForAll :: SDoc -> LHsTyVarBndr GhcRn -> FreeVars -> TcM ()
1456 warnUnusedForAll in_doc (dL->L loc tv) used_names
1457 = whenWOptM Opt_WarnUnusedForalls $
1458 unless (hsTyVarName tv `elemNameSet` used_names) $
1459 addWarnAt (Reason Opt_WarnUnusedForalls) loc $
1460 vcat [ text "Unused quantified type variable" <+> quotes (ppr tv)
1461 , in_doc ]
1462
1463 opTyErr :: Outputable a => RdrName -> a -> SDoc
1464 opTyErr op overall_ty
1465 = hang (text "Illegal operator" <+> quotes (ppr op) <+> ptext (sLit "in type") <+> quotes (ppr overall_ty))
1466 2 extra
1467 where
1468 extra | op == dot_tv_RDR
1469 = perhapsForallMsg
1470 | otherwise
1471 = text "Use TypeOperators to allow operators in types"
1472
1473 {-
1474 ************************************************************************
1475 * *
1476 Finding the free type variables of a (HsType RdrName)
1477 * *
1478 ************************************************************************
1479
1480
1481 Note [Kind and type-variable binders]
1482 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1483 In a type signature we may implicitly bind type variable and, more
1484 recently, kind variables. For example:
1485 * f :: a -> a
1486 f = ...
1487 Here we need to find the free type variables of (a -> a),
1488 so that we know what to quantify
1489
1490 * class C (a :: k) where ...
1491 This binds 'k' in ..., as well as 'a'
1492
1493 * f (x :: a -> [a]) = ....
1494 Here we bind 'a' in ....
1495
1496 * f (x :: T a -> T (b :: k)) = ...
1497 Here we bind both 'a' and the kind variable 'k'
1498
1499 * type instance F (T (a :: Maybe k)) = ...a...k...
1500 Here we want to constrain the kind of 'a', and bind 'k'.
1501
1502 In general we want to walk over a type, and find
1503 * Its free type variables
1504 * The free kind variables of any kind signatures in the type
1505
1506 Hence we return a pair (kind-vars, type vars)
1507 (See Note [HsBSig binder lists] in HsTypes.)
1508 Moreover, we preserve the left-to-right order of the first occurrence of each
1509 variable, while preserving dependency order.
1510 (See Note [Ordering of implicit variables].)
1511
1512 Most clients of this code just want to know the kind/type vars, without
1513 duplicates. The function rmDupsInRdrTyVars removes duplicates. That function
1514 also makes sure that no variable is reported as both a kind var and
1515 a type var, preferring kind vars. Why kind vars? Consider this:
1516
1517 foo :: forall (a :: k). Proxy k -> Proxy a -> ...
1518
1519 Should that be accepted?
1520
1521 Normally, if a type signature has an explicit forall, it must list *all*
1522 tyvars mentioned in the type. But there's an exception for tyvars mentioned in
1523 a kind, as k is above. Note that k is also used "as a type variable", as the
1524 argument to the first Proxy. So, do we consider k to be type-variable-like and
1525 require it in the forall? Or do we consider k to be kind-variable-like and not
1526 require it?
1527
1528 It's not just in type signatures: kind variables are implicitly brought into
1529 scope in a variety of places. Should vars used at both the type level and kind
1530 level be treated this way?
1531
1532 GHC indeed allows kind variables to be brought into scope implicitly even when
1533 the kind variable is also used as a type variable. Thus, we must prefer to keep
1534 a variable listed as a kind var in rmDupsInRdrTyVars. If we kept it as a type
1535 var, then this would prevent it from being implicitly quantified (see
1536 rnImplicitBndrs). In the `foo` example above, that would have the consequence
1537 of the k in Proxy k being reported as out of scope.
1538
1539 Note [Ordering of implicit variables]
1540 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1541 Since the advent of -XTypeApplications, GHC makes promises about the ordering
1542 of implicit variable quantification. Specifically, we offer that implicitly
1543 quantified variables (such as those in const :: a -> b -> a, without a `forall`)
1544 will occur in left-to-right order of first occurrence. Here are a few examples:
1545
1546 const :: a -> b -> a -- forall a b. ...
1547 f :: Eq a => b -> a -> a -- forall a b. ... contexts are included
1548
1549 type a <-< b = b -> a
1550 g :: a <-< b -- forall a b. ... type synonyms matter
1551
1552 class Functor f where
1553 fmap :: (a -> b) -> f a -> f b -- forall f a b. ...
1554 -- The f is quantified by the class, so only a and b are considered in fmap
1555
1556 This simple story is complicated by the possibility of dependency: all variables
1557 must come after any variables mentioned in their kinds.
1558
1559 typeRep :: Typeable a => TypeRep (a :: k) -- forall k a. ...
1560
1561 The k comes first because a depends on k, even though the k appears later than
1562 the a in the code. Thus, GHC does ScopedSort on the variables.
1563 See Note [ScopedSort] in Type.
1564
1565 Implicitly bound variables are collected by any function which returns a
1566 FreeKiTyVars, FreeKiTyVarsWithDups, or FreeKiTyVarsNoDups, which notably
1567 includes the `extract-` family of functions (extractHsTysRdrTyVars,
1568 extractHsTyVarBndrsKVs, etc.).
1569 These functions thus promise to keep left-to-right ordering.
1570 Look for pointers to this note to see the places where the action happens.
1571
1572 Note that we also maintain this ordering in kind signatures. Even though
1573 there's no visible kind application (yet), having implicit variables be
1574 quantified in left-to-right order in kind signatures is nice since:
1575
1576 * It's consistent with the treatment for type signatures.
1577 * It can affect how types are displayed with -fprint-explicit-kinds (see
1578 #15568 for an example), which is a situation where knowing the order in
1579 which implicit variables are quantified can be useful.
1580 * In the event that visible kind application is implemented, the order in
1581 which we would expect implicit variables to be ordered in kinds will have
1582 already been established.
1583 -}
1584
1585 -- See Note [Kind and type-variable binders]
1586 -- These lists are guaranteed to preserve left-to-right ordering of
1587 -- the types the variables were extracted from. See also
1588 -- Note [Ordering of implicit variables].
1589 data FreeKiTyVars = FKTV { fktv_kis :: [Located RdrName]
1590 , fktv_tys :: [Located RdrName] }
1591
1592 -- | A 'FreeKiTyVars' list that is allowed to have duplicate variables.
1593 type FreeKiTyVarsWithDups = FreeKiTyVars
1594
1595 -- | A 'FreeKiTyVars' list that contains no duplicate variables.
1596 type FreeKiTyVarsNoDups = FreeKiTyVars
1597
1598 instance Outputable FreeKiTyVars where
1599 ppr (FKTV { fktv_kis = kis, fktv_tys = tys}) = ppr (kis, tys)
1600
1601 emptyFKTV :: FreeKiTyVarsNoDups
1602 emptyFKTV = FKTV { fktv_kis = [], fktv_tys = [] }
1603
1604 freeKiTyVarsAllVars :: FreeKiTyVars -> [Located RdrName]
1605 freeKiTyVarsAllVars (FKTV { fktv_kis = kvs, fktv_tys = tvs }) = kvs ++ tvs
1606
1607 freeKiTyVarsKindVars :: FreeKiTyVars -> [Located RdrName]
1608 freeKiTyVarsKindVars = fktv_kis
1609
1610 freeKiTyVarsTypeVars :: FreeKiTyVars -> [Located RdrName]
1611 freeKiTyVarsTypeVars = fktv_tys
1612
1613 filterInScope :: LocalRdrEnv -> FreeKiTyVars -> FreeKiTyVars
1614 filterInScope rdr_env (FKTV { fktv_kis = kis, fktv_tys = tys })
1615 = FKTV { fktv_kis = filterOut in_scope kis
1616 , fktv_tys = filterOut in_scope tys }
1617 where
1618 in_scope = inScope rdr_env . unLoc
1619
1620 inScope :: LocalRdrEnv -> RdrName -> Bool
1621 inScope rdr_env rdr = rdr `elemLocalRdrEnv` rdr_env
1622
1623 -- | 'extractHsTyRdrTyVars' finds the
1624 -- free (kind, type) variables of an 'HsType'
1625 -- or the free (sort, kind) variables of an 'HsKind'.
1626 -- It's used when making the @forall@s explicit.
1627 -- Does not return any wildcards.
1628 -- When the same name occurs multiple times in the types, only the first
1629 -- occurrence is returned.
1630 -- See Note [Kind and type-variable binders]
1631
1632
1633 extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
1634 extract_tyarg (HsValArg ty) acc = extract_lty TypeLevel ty acc
1635 extract_tyarg (HsTypeArg ki) acc = extract_lty KindLevel ki acc
1636 extract_tyarg (HsArgPar _) acc = acc
1637
1638 extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
1639 extract_tyargs args acc = foldr extract_tyarg acc args
1640
1641 extractHsTyArgRdrKiTyVarsDup :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups
1642 extractHsTyArgRdrKiTyVarsDup args = extract_tyargs args emptyFKTV
1643
1644 extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVarsNoDups
1645 extractHsTyRdrTyVars ty
1646 = rmDupsInRdrTyVars (extractHsTyRdrTyVarsDups ty)
1647
1648 -- | 'extractHsTyRdrTyVarsDups' find the
1649 -- free (kind, type) variables of an 'HsType'
1650 -- or the free (sort, kind) variables of an 'HsKind'.
1651 -- It's used when making the @forall@s explicit.
1652 -- Does not return any wildcards.
1653 -- When the same name occurs multiple times in the types, all occurrences
1654 -- are returned.
1655 extractHsTyRdrTyVarsDups :: LHsType GhcPs -> FreeKiTyVarsWithDups
1656 extractHsTyRdrTyVarsDups ty
1657 = extract_lty TypeLevel ty emptyFKTV
1658
1659 -- | Extracts the free kind variables (but not the type variables) of an
1660 -- 'HsType'. Does not return any wildcards.
1661 -- When the same name occurs multiple times in the type, only the first
1662 -- occurrence is returned, and the left-to-right order of variables is
1663 -- preserved.
1664 -- See Note [Kind and type-variable binders] and
1665 -- Note [Ordering of implicit variables].
1666 extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> [Located RdrName]
1667 extractHsTyRdrTyVarsKindVars ty
1668 = freeKiTyVarsKindVars (extractHsTyRdrTyVars ty)
1669
1670 -- | Extracts free type and kind variables from types in a list.
1671 -- When the same name occurs multiple times in the types, only the first
1672 -- occurrence is returned and the rest is filtered out.
1673 -- See Note [Kind and type-variable binders]
1674 extractHsTysRdrTyVars :: [LHsType GhcPs] -> FreeKiTyVarsNoDups
1675 extractHsTysRdrTyVars tys
1676 = rmDupsInRdrTyVars (extractHsTysRdrTyVarsDups tys)
1677
1678 -- | Extracts free type and kind variables from types in a list.
1679 -- When the same name occurs multiple times in the types, all occurrences
1680 -- are returned.
1681 extractHsTysRdrTyVarsDups :: [LHsType GhcPs] -> FreeKiTyVarsWithDups
1682 extractHsTysRdrTyVarsDups tys
1683 = extract_ltys TypeLevel tys emptyFKTV
1684
1685 extractHsTyVarBndrsKVs :: [LHsTyVarBndr GhcPs] -> [Located RdrName]
1686 -- Returns the free kind variables of any explictly-kinded binders, returning
1687 -- variable occurrences in left-to-right order.
1688 -- See Note [Ordering of implicit variables].
1689 -- NB: Does /not/ delete the binders themselves.
1690 -- However duplicates are removed
1691 -- E.g. given [k1, a:k1, b:k2]
1692 -- the function returns [k1,k2], even though k1 is bound here
1693 extractHsTyVarBndrsKVs tv_bndrs
1694 = nubL (extract_hs_tv_bndrs_kvs tv_bndrs)
1695
1696 -- | Removes multiple occurrences of the same name from FreeKiTyVars. If a
1697 -- variable occurs as both a kind and a type variable, only keep the occurrence
1698 -- as a kind variable.
1699 -- See also Note [Kind and type-variable binders]
1700 rmDupsInRdrTyVars :: FreeKiTyVarsWithDups -> FreeKiTyVarsNoDups
1701 rmDupsInRdrTyVars (FKTV { fktv_kis = kis, fktv_tys = tys })
1702 = FKTV { fktv_kis = kis'
1703 , fktv_tys = nubL (filterOut (`elemRdr` kis') tys) }
1704 where
1705 kis' = nubL kis
1706
1707 extractRdrKindSigVars :: LFamilyResultSig GhcPs -> [Located RdrName]
1708 -- Returns the free kind variables in a type family result signature, returning
1709 -- variable occurrences in left-to-right order.
1710 -- See Note [Ordering of implicit variables].
1711 extractRdrKindSigVars (dL->L _ resultSig)
1712 | KindSig _ k <- resultSig = kindRdrNameFromSig k
1713 | TyVarSig _ (dL->L _ (KindedTyVar _ _ k)) <- resultSig = kindRdrNameFromSig k
1714 | otherwise = []
1715 where
1716 kindRdrNameFromSig k = freeKiTyVarsAllVars (extractHsTyRdrTyVars k)
1717
1718 extractDataDefnKindVars :: HsDataDefn GhcPs -> [Located RdrName]
1719 -- Get the scoped kind variables mentioned free in the constructor decls
1720 -- Eg: data T a = T1 (S (a :: k) | forall (b::k). T2 (S b)
1721 -- Here k should scope over the whole definition
1722 --
1723 -- However, do NOT collect free kind vars from the deriving clauses:
1724 -- Eg: (Trac #14331) class C p q
1725 -- data D = D deriving ( C (a :: k) )
1726 -- Here k should /not/ scope over the whole definition. We intend
1727 -- this to elaborate to:
1728 -- class C @k1 @k2 (p::k1) (q::k2)
1729 -- data D = D
1730 -- instance forall k (a::k). C @k @* a D where ...
1731 --
1732 -- This returns variable occurrences in left-to-right order.
1733 -- See Note [Ordering of implicit variables].
1734 extractDataDefnKindVars (HsDataDefn { dd_ctxt = ctxt, dd_kindSig = ksig
1735 , dd_cons = cons })
1736 = (nubL . freeKiTyVarsKindVars) $
1737 (extract_lctxt TypeLevel ctxt $
1738 extract_mb extract_lkind ksig $
1739 foldr (extract_con . unLoc) emptyFKTV cons)
1740 where
1741 extract_con (ConDeclGADT { }) acc = acc
1742 extract_con (ConDeclH98 { con_ex_tvs = ex_tvs
1743 , con_mb_cxt = ctxt, con_args = args }) acc
1744 = extract_hs_tv_bndrs ex_tvs acc $
1745 extract_mlctxt ctxt $
1746 extract_ltys TypeLevel (hsConDeclArgTys args) emptyFKTV
1747 extract_con (XConDecl { }) _ = panic "extractDataDefnKindVars"
1748 extractDataDefnKindVars (XHsDataDefn _) = panic "extractDataDefnKindVars"
1749
1750 extract_mlctxt :: Maybe (LHsContext GhcPs)
1751 -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
1752 extract_mlctxt Nothing acc = acc
1753 extract_mlctxt (Just ctxt) acc = extract_lctxt TypeLevel ctxt acc
1754
1755 extract_lctxt :: TypeOrKind
1756 -> LHsContext GhcPs
1757 -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
1758 extract_lctxt t_or_k ctxt = extract_ltys t_or_k (unLoc ctxt)
1759
1760 extract_ltys :: TypeOrKind
1761 -> [LHsType GhcPs]
1762 -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
1763 extract_ltys t_or_k tys acc = foldr (extract_lty t_or_k) acc tys
1764
1765 extract_mb :: (a -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
1766 -> Maybe a
1767 -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
1768 extract_mb _ Nothing acc = acc
1769 extract_mb f (Just x) acc = f x acc
1770
1771 extract_lkind :: LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
1772 extract_lkind = extract_lty KindLevel
1773
1774 extract_lty :: TypeOrKind -> LHsType GhcPs
1775 -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
1776 extract_lty t_or_k (dL->L _ ty) acc
1777 = case ty of
1778 HsTyVar _ _ ltv -> extract_tv t_or_k ltv acc
1779 HsBangTy _ _ ty -> extract_lty t_or_k ty acc
1780 HsRecTy _ flds -> foldr (extract_lty t_or_k
1781 . cd_fld_type . unLoc) acc
1782 flds
1783 HsAppTy _ ty1 ty2 -> extract_lty t_or_k ty1 $
1784 extract_lty t_or_k ty2 acc
1785 HsAppKindTy _ ty k -> extract_lty t_or_k ty $
1786 extract_lty KindLevel k acc
1787 HsListTy _ ty -> extract_lty t_or_k ty acc
1788 HsTupleTy _ _ tys -> extract_ltys t_or_k tys acc
1789 HsSumTy _ tys -> extract_ltys t_or_k tys acc
1790 HsFunTy _ ty1 ty2 -> extract_lty t_or_k ty1 $
1791 extract_lty t_or_k ty2 acc
1792 HsIParamTy _ _ ty -> extract_lty t_or_k ty acc
1793 HsOpTy _ ty1 tv ty2 -> extract_tv t_or_k tv $
1794 extract_lty t_or_k ty1 $
1795 extract_lty t_or_k ty2 acc
1796 HsParTy _ ty -> extract_lty t_or_k ty acc
1797 HsSpliceTy {} -> acc -- Type splices mention no tvs
1798 HsDocTy _ ty _ -> extract_lty t_or_k ty acc
1799 HsExplicitListTy _ _ tys -> extract_ltys t_or_k tys acc
1800 HsExplicitTupleTy _ tys -> extract_ltys t_or_k tys acc
1801 HsTyLit _ _ -> acc
1802 HsStarTy _ _ -> acc
1803 HsKindSig _ ty ki -> extract_lty t_or_k ty $
1804 extract_lkind ki acc
1805 HsForAllTy { hst_bndrs = tvs, hst_body = ty }
1806 -> extract_hs_tv_bndrs tvs acc $
1807 extract_lty t_or_k ty emptyFKTV
1808 HsQualTy { hst_ctxt = ctxt, hst_body = ty }
1809 -> extract_lctxt t_or_k ctxt $
1810 extract_lty t_or_k ty acc
1811 XHsType {} -> acc
1812 -- We deal with these separately in rnLHsTypeWithWildCards
1813 HsWildCardTy {} -> acc
1814
1815 extractHsTvBndrs :: [LHsTyVarBndr GhcPs]
1816 -> FreeKiTyVarsWithDups -- Free in body
1817 -> FreeKiTyVarsWithDups -- Free in result
1818 extractHsTvBndrs tv_bndrs body_fvs
1819 = extract_hs_tv_bndrs tv_bndrs emptyFKTV body_fvs
1820
1821 extract_hs_tv_bndrs :: [LHsTyVarBndr GhcPs]
1822 -> FreeKiTyVarsWithDups -- Accumulator
1823 -> FreeKiTyVarsWithDups -- Free in body
1824 -> FreeKiTyVarsWithDups
1825 -- In (forall (a :: Maybe e). a -> b) we have
1826 -- 'a' is bound by the forall
1827 -- 'b' is a free type variable
1828 -- 'e' is a free kind variable
1829 extract_hs_tv_bndrs tv_bndrs
1830 (FKTV { fktv_kis = acc_kvs, fktv_tys = acc_tvs }) -- Accumulator
1831 (FKTV { fktv_kis = body_kvs, fktv_tys = body_tvs }) -- Free in the body
1832 | null tv_bndrs
1833 = FKTV { fktv_kis = body_kvs ++ acc_kvs
1834 , fktv_tys = body_tvs ++ acc_tvs }
1835 | otherwise
1836 = FKTV { fktv_kis = filterOut (`elemRdr` tv_bndr_rdrs) all_kv_occs
1837 -- NB: delete all tv_bndr_rdrs from bndr_kvs as well
1838 -- as body_kvs; see Note [Kind variable scoping]
1839 ++ acc_kvs
1840 , fktv_tys = filterOut (`elemRdr` tv_bndr_rdrs) body_tvs ++ acc_tvs }
1841 where
1842 bndr_kvs = extract_hs_tv_bndrs_kvs tv_bndrs
1843
1844 tv_bndr_rdrs, all_kv_occs :: [Located RdrName]
1845 tv_bndr_rdrs = map hsLTyVarLocName tv_bndrs
1846 all_kv_occs = bndr_kvs ++ body_kvs
1847 -- We must include both kind variables from the binding as well
1848 -- as the body of the `forall` type.
1849 -- See Note [Variables used as both types and kinds].
1850
1851 extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr GhcPs] -> [Located RdrName]
1852 -- Returns the free kind variables of any explictly-kinded binders, returning
1853 -- variable occurrences in left-to-right order.
1854 -- See Note [Ordering of implicit variables].
1855 -- NB: Does /not/ delete the binders themselves.
1856 -- Duplicates are /not/ removed
1857 -- E.g. given [k1, a:k1, b:k2]
1858 -- the function returns [k1,k2], even though k1 is bound here
1859 extract_hs_tv_bndrs_kvs tv_bndrs
1860 = freeKiTyVarsKindVars $ -- There will /be/ no free tyvars!
1861 foldr extract_lkind emptyFKTV
1862 [k | (dL->L _ (KindedTyVar _ _ k)) <- tv_bndrs]
1863
1864 extract_tv :: TypeOrKind -> Located RdrName
1865 -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
1866 extract_tv t_or_k ltv@(dL->L _ tv) acc@(FKTV kvs tvs)
1867 | not (isRdrTyVar tv) = acc
1868 | isTypeLevel t_or_k = FKTV { fktv_kis = kvs, fktv_tys = ltv : tvs }
1869 | otherwise = FKTV { fktv_kis = ltv : kvs, fktv_tys = tvs }
1870
1871 -- Deletes duplicates in a list of Located things.
1872 --
1873 -- Importantly, this function is stable with respect to the original ordering
1874 -- of things in the list. This is important, as it is a property that GHC
1875 -- relies on to maintain the left-to-right ordering of implicitly quantified
1876 -- type variables.
1877 -- See Note [Ordering of implicit variables].
1878 nubL :: Eq a => [Located a] -> [Located a]
1879 nubL = nubBy eqLocated
1880
1881 elemRdr :: Located RdrName -> [Located RdrName] -> Bool
1882 elemRdr x = any (eqLocated x)