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