{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE ViewPatterns        #-}

{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

-}

module GHC.Rename.HsType (
        -- Type related stuff
        rnHsType, rnLHsType, rnLHsTypes, rnContext, rnMaybeContext,
        rnModifier, rnModifierWith,
        rnModifierContext, rnModifiersContext, rnModifiersContextAndWarn,
        rnLHsKind, rnLHsTypeArgs,
        rnHsSigType, rnHsWcType, rnHsModifiedFunArrWith,
        HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType, rnHsPatSigKind,
        newTyVarNameRn,
        rnHsConDeclRecFields,
        lookupField, mkHsOpTyRn,
        rnLTyVar,

        rnHsConDeclField,

        -- Precence related stuff
        NegationHandling(..),
        mkOpAppRn, mkNegAppRn, mkConOpPatRn,
        checkPrecMatch, checkSectionPrec,

        -- Binding related stuff
        bindHsOuterTyVarBndrs, bindHsForAllTelescope,
        bindHsForAllTelescopes,
        bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..),
        rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars,
        FreeKiTyVars, filterInScopeM,
        extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
        extractHsTysRdrTyVars, extractRdrKindSigVars,
        extractConDeclGADTDetailsTyVars, extractDataDefnKindVars,
        extractHsOuterTvBndrs, extractHsTyArgRdrKiTyVars,
        extractHsForAllTelescopes,
        nubL, nubN,

        -- Error helpers
        badKindSigErr
  ) where

import GHC.Prelude

import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType, checkThLocalTyName, checkThLocalNameNoLift )

import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList )
import GHC.Core.TyCon    ( isKindName )
import GHC.Driver.Flags
import GHC.Hs
import GHC.Rename.Env
import GHC.Rename.Doc
import GHC.Rename.Utils  ( mapFvRn, bindLocalNamesFV
                         , typeAppErr, newLocalBndrRn, checkDupRdrNames
                         , checkShadowedRdrNames )
import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn
                         , lookupTypeFixityRn )
import GHC.Rename.Unbound ( notInScopeErr, WhereLooking(WL_LocalOnly) )
import GHC.Tc.Errors.Types
import GHC.Tc.Errors.Ppr ( pprHsDocContext )
import GHC.Tc.Utils.Monad
import GHC.Unit.Module ( getModule )
import GHC.Types.Name.Reader
import GHC.Builtin.Names
import GHC.Builtin.Types
import GHC.Types.Hint ( UntickedPromotedThing(..) )
import GHC.Types.Name
import GHC.Types.SrcLoc
import GHC.Types.Name.Set
import GHC.Types.FieldLabel
import GHC.Types.SourceText

import GHC.Utils.Misc
import GHC.Types.Fixity ( compareFixity, negateFixity )
import GHC.Types.Basic  ( TypeOrKind(..) )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.FastString
import GHC.Data.Maybe
import qualified GHC.LanguageExtensions as LangExt

import Data.List (nubBy, partition)
import Control.Monad

{-
These type renamers are in a separate module, rather than in (say) GHC.Rename.Module,
to break several loops.

*********************************************************
*                                                       *
    HsSigWcType and HsPatSigType (i.e with wildcards)
*                                                       *
*********************************************************
-}

data HsPatSigTypeScoping
  = AlwaysBind
    -- ^ Always bind any free tyvars of the given type, regardless of whether we
    -- have a forall at the top.
    --
    -- For pattern type sigs, we /do/ want to bring those type
    -- variables into scope, even if there's a forall at the top which usually
    -- stops that happening, e.g:
    --
    -- > \ (x :: forall a. a -> b) -> e
    --
    -- Here we do bring 'b' into scope.
    --
    -- RULES can also use 'AlwaysBind', such as in the following example:
    --
    -- > {-# RULES \"f\" forall (x :: forall a. a -> b). f x = ... b ... #-}
    --
    -- This only applies to RULES that do not explicitly bind their type
    -- variables. If a RULE explicitly quantifies its type variables, then
    -- 'NeverBind' is used instead. See also
    -- @Note [Pattern signature binders and scoping]@ in "GHC.Hs.Type".
  | NeverBind
    -- ^ Never bind any free tyvars. This is used for RULES that have both
    -- explicit type and term variable binders, e.g.:
    --
    -- > {-# RULES \"const\" forall a. forall (x :: a) y. const x y = x #-}
    --
    -- The presence of the type variable binder @forall a.@ implies that the
    -- free variables in the types of the term variable binders @x@ and @y@
    -- are /not/ bound. In the example above, there are no such free variables,
    -- but if the user had written @(y :: b)@ instead of @y@ in the term
    -- variable binders, then @b@ would be rejected for being out of scope.
    -- See also @Note [Pattern signature binders and scoping]@ in
    -- "GHC.Hs.Type".

rnHsSigWcType :: HsDocContext
              -> LHsSigWcType GhcPs
              -> RnM (LHsSigWcType GhcRn, FreeNames)
rnHsSigWcType :: HsDocContext
-> LHsSigWcType GhcPs -> RnM (LHsSigWcType GhcRn, FreeNames)
rnHsSigWcType HsDocContext
doc (HsWC { hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body =
    sig_ty :: LHsSigType GhcPs
sig_ty@(L SrcSpanAnnA
loc (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcPs
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
body_ty })) })
  = do { free_vars <- FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM (LHsSigType GhcPs -> FreeKiTyVars
extract_lhs_sig_ty LHsSigType GhcPs
sig_ty)
       ; (nwc_rdrs', imp_tv_nms) <- partition_nwcs free_vars
       ; let nwc_rdrs = FreeKiTyVars -> FreeKiTyVars
forall a l. Eq a => [GenLocated l a] -> [GenLocated l a]
nubL FreeKiTyVars
nwc_rdrs'
       ; bindHsOuterTyVarBndrs doc Nothing imp_tv_nms outer_bndrs $ \HsOuterTyVarBndrs Specificity GhcRn
outer_bndrs' ->
    do { (wcs, body_ty', fvs) <- HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeNames)
rnWcBodyType HsDocContext
doc FreeKiTyVars
nwc_rdrs LHsType GhcPs
body_ty
       ; pure ( HsWC  { hswc_ext = wcs, hswc_body = L loc $
                HsSig { sig_ext = noExtField
                      , sig_bndrs = outer_bndrs', sig_body = body_ty' }}
              , fvs) } }

rnHsPatSigType :: HsPatSigTypeScoping
               -> HsDocContext
               -> HsPatSigType GhcPs
               -> (HsPatSigType GhcRn -> RnM (a, FreeNames))
               -> RnM (a, FreeNames)
rnHsPatSigType :: forall a.
HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
rnHsPatSigType = TypeOrKind
-> HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall a.
TypeOrKind
-> HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
rnHsPatSigTyKi TypeOrKind
TypeLevel

rnHsPatSigKind :: HsPatSigTypeScoping
               -> HsDocContext
               -> HsPatSigType GhcPs
               -> (HsPatSigType GhcRn -> RnM (a, FreeNames))
               -> RnM (a, FreeNames)
rnHsPatSigKind :: forall a.
HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
rnHsPatSigKind = TypeOrKind
-> HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall a.
TypeOrKind
-> HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
rnHsPatSigTyKi TypeOrKind
KindLevel

rnHsPatSigTyKi :: TypeOrKind
               -> HsPatSigTypeScoping
               -> HsDocContext
               -> HsPatSigType GhcPs
               -> (HsPatSigType GhcRn -> RnM (a, FreeNames))
               -> RnM (a, FreeNames)
-- Used for
--   - Pattern type signatures, which are only allowed with ScopedTypeVariables
--   - Signatures on binders in a RULE, which are allowed even if
--     ScopedTypeVariables isn't enabled
-- Wildcards are allowed
--
-- See Note [Pattern signature binders and scoping] in GHC.Hs.Type
rnHsPatSigTyKi :: forall a.
TypeOrKind
-> HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
rnHsPatSigTyKi TypeOrKind
level HsPatSigTypeScoping
scoping HsDocContext
ctx HsPatSigType GhcPs
sig_ty HsPatSigType GhcRn -> RnM (a, FreeNames)
thing_inside
  = do { ty_sig_okay <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.ScopedTypeVariables
       ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty)
       ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty)
       ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars
       ; let nwc_rdrs = FreeKiTyVars -> FreeKiTyVars
forall a. Eq a => [LocatedN a] -> [LocatedN a]
nubN FreeKiTyVars
nwc_rdrs'
             implicit_bndrs = case HsPatSigTypeScoping
scoping of
               HsPatSigTypeScoping
AlwaysBind -> FreeKiTyVars
tv_rdrs
               HsPatSigTypeScoping
NeverBind  -> []
       ; rnImplicitTvOccs Nothing implicit_bndrs $ \ [Name]
imp_tvs ->
    do { (nwcs, pat_sig_ty', fvs1) <- TypeOrKind
-> HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeNames)
rnWcBodyTyKi TypeOrKind
level HsDocContext
ctx FreeKiTyVars
nwc_rdrs LHsType GhcPs
pat_sig_ty
       ; let sig_names = HsPSRn { hsps_nwcs :: [Name]
hsps_nwcs = [Name]
nwcs, hsps_imp_tvs :: [Name]
hsps_imp_tvs = [Name]
imp_tvs }
             sig_ty'   = HsPS { hsps_ext :: XHsPS GhcRn
hsps_ext = XHsPS GhcRn
HsPSRn
sig_names, hsps_body :: LHsType GhcRn
hsps_body = LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
pat_sig_ty' }
       ; (res, fvs2) <- thing_inside sig_ty'
       ; return (res, fvs1 `plusFN` fvs2) } }
  where
    pat_sig_ty :: LHsType GhcPs
pat_sig_ty = HsPatSigType GhcPs -> LHsType GhcPs
forall (p :: Pass). HsPatSigType (GhcPass p) -> LHsType (GhcPass p)
hsPatSigType HsPatSigType GhcPs
sig_ty

rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeNames)
rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeNames)
rnHsWcType HsDocContext
ctxt (HsWC { hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = LHsType GhcPs
hs_ty })
  = do { free_vars <- FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM (LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
hs_ty)
       ; (nwc_rdrs', _) <- partition_nwcs free_vars
       ; let nwc_rdrs = FreeKiTyVars -> FreeKiTyVars
forall a l. Eq a => [GenLocated l a] -> [GenLocated l a]
nubL FreeKiTyVars
nwc_rdrs'
       ; (wcs, hs_ty', fvs) <- rnWcBodyType ctxt nwc_rdrs hs_ty
       ; let sig_ty' = HsWC { hswc_ext :: XHsWC GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
hswc_ext = [Name]
XHsWC GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
wcs, hswc_body :: GenLocated SrcSpanAnnA (HsType GhcRn)
hswc_body = GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty' }
       ; return (sig_ty', fvs) }


rnWcBodyType :: HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs
  -> RnM ([Name], LHsType GhcRn, FreeNames)
rnWcBodyType :: HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeNames)
rnWcBodyType = TypeOrKind
-> HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeNames)
rnWcBodyTyKi TypeOrKind
TypeLevel

rnWcBodyTyKi :: TypeOrKind -> HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs
         -> RnM ([Name], LHsType GhcRn, FreeNames)
rnWcBodyTyKi :: TypeOrKind
-> HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeNames)
rnWcBodyTyKi TypeOrKind
level HsDocContext
ctxt FreeKiTyVars
nwc_rdrs LHsType GhcPs
hs_ty
  = do { nwcs <- (GenLocated SrcSpanAnnN RdrName
 -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> FreeKiTyVars -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newLocalBndrRn FreeKiTyVars
nwc_rdrs
       ; let env = RTKE { rtke_level :: TypeOrKind
rtke_level = TypeOrKind
level
                        , rtke_what :: RnTyKiWhat
rtke_what  = RnTyKiWhat
RnTypeBody
                        , rtke_nwcs :: FreeNames
rtke_nwcs  = [Name] -> FreeNames
mkNameSet [Name]
nwcs
                        , rtke_ctxt :: HsDocContext
rtke_ctxt  = HsDocContext
ctxt }
       ; (hs_ty', fvs) <- bindLocalNamesFV nwcs $
                          rn_lty env hs_ty
       ; return (nwcs, hs_ty', fvs) }
  where
    rn_lty :: RnTyKiEnv
-> GenLocated (EpAnn ann) (HsType GhcPs)
-> TcRn (GenLocated (EpAnn ann) (HsType GhcRn), FreeNames)
rn_lty RnTyKiEnv
env (L EpAnn ann
loc HsType GhcPs
hs_ty)
      = EpAnn ann
-> TcRn (GenLocated (EpAnn ann) (HsType GhcRn), FreeNames)
-> TcRn (GenLocated (EpAnn ann) (HsType GhcRn), FreeNames)
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA EpAnn ann
loc (TcRn (GenLocated (EpAnn ann) (HsType GhcRn), FreeNames)
 -> TcRn (GenLocated (EpAnn ann) (HsType GhcRn), FreeNames))
-> TcRn (GenLocated (EpAnn ann) (HsType GhcRn), FreeNames)
-> TcRn (GenLocated (EpAnn ann) (HsType GhcRn), FreeNames)
forall a b. (a -> b) -> a -> b
$
        do { (hs_ty', fvs) <- RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
rn_ty RnTyKiEnv
env HsType GhcPs
hs_ty
           ; return (L loc hs_ty', fvs) }

    rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
    -- A lot of faff just to allow the extra-constraints wildcard to appear
    rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
rn_ty RnTyKiEnv
env (HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllTelescope GhcPs
tele, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
hs_body })
      = HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeNames))
-> RnM (HsType GhcRn, FreeNames)
forall a.
HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
bindHsForAllTelescope (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) HsForAllTelescope GhcPs
tele ((HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeNames))
 -> RnM (HsType GhcRn, FreeNames))
-> (HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeNames))
-> RnM (HsType GhcRn, FreeNames)
forall a b. (a -> b) -> a -> b
$ \ HsForAllTelescope GhcRn
tele' ->
        do { (hs_body', fvs) <- RnTyKiEnv
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames)
forall {ann}.
RnTyKiEnv
-> GenLocated (EpAnn ann) (HsType GhcPs)
-> TcRn (GenLocated (EpAnn ann) (HsType GhcRn), FreeNames)
rn_lty RnTyKiEnv
env LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hs_body
           ; return (HsForAllTy { hst_xforall = noExtField
                                , hst_tele = tele', hst_body = hs_body' }
                    , fvs) }

    rn_ty RnTyKiEnv
env (HsQualTy { hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_ctxt = L SrcSpanAnnC
cx [GenLocated SrcSpanAnnA (HsType GhcPs)]
hs_ctxt
                        , hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
hs_ty })
      | Just ([GenLocated SrcSpanAnnA (HsType GhcPs)]
hs_ctxt1, GenLocated SrcSpanAnnA (HsType GhcPs)
hs_ctxt_last) <- [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Maybe
     ([GenLocated SrcSpanAnnA (HsType GhcPs)],
      GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. [a] -> Maybe ([a], a)
snocView [GenLocated SrcSpanAnnA (HsType GhcPs)]
hs_ctxt
      , L SrcSpanAnnA
lx (HsWildCardTy XWildCardTy GhcPs
_)  <- LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
ignoreParens LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hs_ctxt_last
      = do { (hs_ctxt1', fvs1) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (RnTyKiEnv
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames)
rn_top_constraint RnTyKiEnv
env) [GenLocated SrcSpanAnnA (HsType GhcPs)]
hs_ctxt1
           ; setSrcSpanA lx $ checkExtraConstraintWildCard env hs_ctxt1
           ; let hs_ctxt' = [GenLocated SrcSpanAnnA (HsType GhcRn)]
hs_ctxt1' [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall a. [a] -> [a] -> [a]
++ [SrcSpanAnnA
-> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
lx (XWildCardTy GhcRn -> HsType GhcRn
forall pass. XWildCardTy pass -> HsType pass
HsWildCardTy XWildCardTy GhcRn
NoExtField
noExtField)]
           ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
           ; return (HsQualTy { hst_xqual = noExtField
                              , hst_ctxt = L cx hs_ctxt'
                              , hst_body = hs_ty' }
                    , fvs1 `plusFN` fvs2) }

      | Bool
otherwise
      = do { (hs_ctxt', fvs1) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (RnTyKiEnv
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames)
rn_top_constraint RnTyKiEnv
env) [GenLocated SrcSpanAnnA (HsType GhcPs)]
hs_ctxt
           ; (hs_ty', fvs2)   <- rnLHsTyKi env hs_ty
           ; return (HsQualTy { hst_xqual = noExtField
                              , hst_ctxt = L cx hs_ctxt'
                              , hst_body = hs_ty' }
                    , fvs1 `plusFN` fvs2) }


    rn_ty RnTyKiEnv
env HsType GhcPs
hs_ty = RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
rnHsTyKi RnTyKiEnv
env HsType GhcPs
hs_ty

    rn_top_constraint :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rn_top_constraint RnTyKiEnv
env = RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi (RnTyKiEnv
env { rtke_what = RnTopConstraint })


checkExtraConstraintWildCard :: RnTyKiEnv -> HsContext GhcPs -> RnM ()
-- Rename the extra-constraint spot in a type signature
--    (blah, _) => type
-- Check that extra-constraints are allowed at all, and
-- if so that it's an anonymous wildcard
checkExtraConstraintWildCard :: RnTyKiEnv -> HsContext GhcPs -> TcRn ()
checkExtraConstraintWildCard RnTyKiEnv
env HsContext GhcPs
hs_ctxt
  = RnTyKiEnv -> Maybe Name -> Maybe BadAnonWildcardContext -> TcRn ()
checkWildCard RnTyKiEnv
env Maybe Name
forall a. Maybe a
Nothing Maybe BadAnonWildcardContext
mb_bad
  where
    mb_bad :: Maybe BadAnonWildcardContext
mb_bad | Bool -> Bool
not (RnTyKiEnv -> Bool
extraConstraintWildCardsAllowed RnTyKiEnv
env)
           = BadAnonWildcardContext -> Maybe BadAnonWildcardContext
BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a. a -> Maybe a
Just (BadAnonWildcardContext -> Maybe BadAnonWildcardContext)
-> BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a b. (a -> b) -> a -> b
$ SoleExtraConstraintWildcardAllowed -> BadAnonWildcardContext
ExtraConstraintWildcardNotAllowed
                      SoleExtraConstraintWildcardAllowed
SoleExtraConstraintWildcardNotAllowed
             -- Currently, we do not allow wildcards in their full glory in
             -- standalone deriving declarations. We only allow a single
             -- extra-constraints wildcard à la:
             --
             --   deriving instance _ => Eq (Foo a)
             --
             -- i.e., we don't support things like
             --
             --   deriving instance (Eq a, _) => Eq (Foo a)
           | DerivDeclCtx {} <- RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env
           , Bool -> Bool
not ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
hs_ctxt)
           = BadAnonWildcardContext -> Maybe BadAnonWildcardContext
BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a. a -> Maybe a
Just (BadAnonWildcardContext -> Maybe BadAnonWildcardContext)
-> BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a b. (a -> b) -> a -> b
$ SoleExtraConstraintWildcardAllowed -> BadAnonWildcardContext
ExtraConstraintWildcardNotAllowed
                      SoleExtraConstraintWildcardAllowed
SoleExtraConstraintWildcardAllowed
           | Bool
otherwise
           = Maybe BadAnonWildcardContext
forall a. Maybe a
Nothing

extraConstraintWildCardsAllowed :: RnTyKiEnv -> Bool
extraConstraintWildCardsAllowed :: RnTyKiEnv -> Bool
extraConstraintWildCardsAllowed RnTyKiEnv
env
  = case RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env of
      TypeSigCtx {}       -> Bool
True
      ExprWithTySigCtx {} -> Bool
True
      DerivDeclCtx {}     -> Bool
True
      StandaloneKindSigCtx {} -> Bool
False  -- See Note [Wildcards in standalone kind signatures] in "GHC.Hs.Decls"
      HsDocContext
_                   -> Bool
False

-- | When the NamedWildCards extension is enabled, partition_nwcs
-- removes type variables that start with an underscore from the
-- FreeKiTyVars in the argument and returns them in a separate list.
-- When the extension is disabled, the function returns the argument
-- and empty list.  See Note [Renaming named wild cards]
partition_nwcs :: FreeKiTyVars -> RnM ([LocatedN RdrName], FreeKiTyVars)
partition_nwcs :: FreeKiTyVars -> RnM (FreeKiTyVars, FreeKiTyVars)
partition_nwcs FreeKiTyVars
free_vars
  = do { wildcards_enabled <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.NamedWildCards
       ; return $
           if wildcards_enabled
           then partition is_wildcard free_vars
           else ([], free_vars) }
  where
     is_wildcard :: LocatedN RdrName -> Bool
     is_wildcard :: GenLocated SrcSpanAnnN RdrName -> Bool
is_wildcard GenLocated SrcSpanAnnN RdrName
rdr = OccName -> Bool
startsWithUnderscore (RdrName -> OccName
rdrNameOcc (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
rdr))

{- Note [Renaming named wild cards]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Identifiers starting with an underscore are always parsed as type variables.
It is only here in the renamer that we give the special treatment.
See Note [The wildcard story for types] in GHC.Hs.Type.

It's easy!  When we collect the implicitly bound type variables, ready
to bring them into scope, and NamedWildCards is on, we partition the
variables into the ones that start with an underscore (the named
wildcards) and the rest. Then we just add them to the hswc_wcs field
of the HsWildCardBndrs structure, and we are done.


*********************************************************
*                                                       *
           HsSigType (i.e. no wildcards)
*                                                       *
****************************************************** -}

rnHsSigType :: HsDocContext
            -> TypeOrKind
            -> LHsSigType GhcPs
            -> RnM (LHsSigType GhcRn, FreeNames)
-- Used for source-language type signatures
-- that cannot have wildcards
rnHsSigType :: HsDocContext
-> TypeOrKind
-> LHsSigType GhcPs
-> RnM (LHsSigType GhcRn, FreeNames)
rnHsSigType HsDocContext
ctx TypeOrKind
level
    (L SrcSpanAnnA
loc sig_ty :: HsSigType GhcPs
sig_ty@(HsSig { sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcPs
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
body }))
  = SrcSpanAnnA
-> RnM (LHsSigType GhcRn, FreeNames)
-> RnM (LHsSigType GhcRn, FreeNames)
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (RnM (LHsSigType GhcRn, FreeNames)
 -> RnM (LHsSigType GhcRn, FreeNames))
-> RnM (LHsSigType GhcRn, FreeNames)
-> RnM (LHsSigType GhcRn, FreeNames)
forall a b. (a -> b) -> a -> b
$
    do { String -> SDoc -> TcRn ()
traceRn String
"rnHsSigType" (HsSigType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsSigType GhcPs
sig_ty)
       ; case HsOuterSigTyVarBndrs GhcPs
outer_bndrs of
           HsOuterExplicit{} -> RnTyKiEnv -> HsTypeOrSigType GhcPs -> TcRn ()
checkPolyKinds RnTyKiEnv
env (HsSigType GhcPs -> HsTypeOrSigType GhcPs
forall p. HsSigType p -> HsTypeOrSigType p
HsSigType HsSigType GhcPs
sig_ty)
           HsOuterImplicit{} -> () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
       ; imp_vars <- FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM (FreeKiTyVars -> RnM FreeKiTyVars)
-> FreeKiTyVars -> RnM FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
body
       ; bindHsOuterTyVarBndrs ctx Nothing imp_vars outer_bndrs $ \HsOuterTyVarBndrs Specificity GhcRn
outer_bndrs' ->
    do { (body', fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
body

       ; return ( L loc $ HsSig { sig_ext = noExtField
                                , sig_bndrs = outer_bndrs', sig_body = body' }
                , fvs ) } }
  where
    env :: RnTyKiEnv
env = HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctx TypeOrKind
level RnTyKiWhat
RnTypeBody

-- | Create new renamed type variables corresponding to source-level ones.
-- Duplicates are permitted, but will be removed. This is intended especially for
-- the case of handling the implicitly bound free variables of a type signature.
rnImplicitTvOccs :: Maybe assoc
                 -- ^ @'Just' _@ => an associated type decl
                 -> FreeKiTyVars
                 -- ^ Surface-syntax free vars that we will implicitly bind.
                 -- May have duplicates, which are removed here.
                 -> ([Name] -> RnM (a, FreeNames))
                 -> RnM (a, FreeNames)
rnImplicitTvOccs :: forall assoc a.
Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
rnImplicitTvOccs Maybe assoc
mb_assoc FreeKiTyVars
implicit_vs_with_dups [Name] -> RnM (a, FreeNames)
thing_inside
  = do { let implicit_vs :: FreeKiTyVars
implicit_vs = FreeKiTyVars -> FreeKiTyVars
forall a. Eq a => [LocatedN a] -> [LocatedN a]
nubN FreeKiTyVars
implicit_vs_with_dups

       ; String -> SDoc -> TcRn ()
traceRn String
"rnImplicitTvOccs" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ FreeKiTyVars -> SDoc
forall a. Outputable a => a -> SDoc
ppr FreeKiTyVars
implicit_vs_with_dups, FreeKiTyVars -> SDoc
forall a. Outputable a => a -> SDoc
ppr FreeKiTyVars
implicit_vs ]

         -- Use the currently set SrcSpan as the new source location for each Name.
         -- See Note [Source locations for implicitly bound type variables].
       ; loc <- TcRn SrcSpan
getSrcSpanM
       ; let loc' = SrcSpan -> SrcSpanAnnN
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc
       ; vars <- mapM (newTyVarNameRnImplicit mb_assoc . L loc' . unLoc) implicit_vs

       ; bindLocalNamesFV vars $
         thing_inside vars }

{-
Note [Source locations for implicitly bound type variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When bringing implicitly bound type variables into scope (in rnImplicitTvOccs),
we do something peculiar: we drop the original SrcSpan attached to each
variable and replace it with the currently set SrcSpan. Moreover, this new
SrcSpan is usually /less/ precise than the original one, and that's OK. To see
why this is done, consider the following example:

  f :: a -> b -> a

Suppose that a warning or error message needs to point to the SrcSpans of the
binding sites for `a` and `b`. But where /are/ they bound, anyway? Technically,
they're bound by an unwritten `forall` at the front of the type signature, but
there is no SrcSpan for that. We could point to the first occurrence of `a` as
the binding site for `a`, but that would make the first occurrence of `a`
special. Moreover, we don't want IDEs to confuse binding sites and occurrences.

As a result, we make the `SrcSpan`s for `a` and `b` span the entirety of the
type signature, since the type signature implicitly carries their binding
sites. This is less precise, but more accurate.
-}

{- ******************************************************
*                                                       *
           LHsType and HsType
*                                                       *
****************************************************** -}

{-
rnHsType is here because we call it from loadInstDecl, and I didn't
want a gratuitous knot.
-}

data RnTyKiEnv
  = RTKE { RnTyKiEnv -> HsDocContext
rtke_ctxt  :: HsDocContext
         , RnTyKiEnv -> TypeOrKind
rtke_level :: TypeOrKind  -- Am I renaming a type or a kind?
         , RnTyKiEnv -> RnTyKiWhat
rtke_what  :: RnTyKiWhat  -- And within that what am I renaming?
         , RnTyKiEnv -> FreeNames
rtke_nwcs  :: NameSet     -- These are the in-scope named wildcards
    }

data RnTyKiWhat = RnTypeBody
                | RnTopConstraint   -- Top-level context of HsSigWcTypes
                | RnConstraint      -- All other constraints

instance Outputable RnTyKiEnv where
  ppr :: RnTyKiEnv -> SDoc
ppr (RTKE { rtke_level :: RnTyKiEnv -> TypeOrKind
rtke_level = TypeOrKind
lev, rtke_what :: RnTyKiEnv -> RnTyKiWhat
rtke_what = RnTyKiWhat
what
            , rtke_nwcs :: RnTyKiEnv -> FreeNames
rtke_nwcs = FreeNames
wcs, rtke_ctxt :: RnTyKiEnv -> HsDocContext
rtke_ctxt = HsDocContext
ctxt })
    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RTKE"
      SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ TypeOrKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeOrKind
lev, RnTyKiWhat -> SDoc
forall a. Outputable a => a -> SDoc
ppr RnTyKiWhat
what, FreeNames -> SDoc
forall a. Outputable a => a -> SDoc
ppr FreeNames
wcs
                      , HsDocContext -> SDoc
pprHsDocContext HsDocContext
ctxt ])

instance Outputable RnTyKiWhat where
  ppr :: RnTyKiWhat -> SDoc
ppr RnTyKiWhat
RnTypeBody      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RnTypeBody"
  ppr RnTyKiWhat
RnTopConstraint = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RnTopConstraint"
  ppr RnTyKiWhat
RnConstraint    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RnConstraint"

mkTyKiEnv :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
cxt TypeOrKind
level RnTyKiWhat
what
 = RTKE { rtke_level :: TypeOrKind
rtke_level = TypeOrKind
level, rtke_nwcs :: FreeNames
rtke_nwcs = FreeNames
emptyNameSet
        , rtke_what :: RnTyKiWhat
rtke_what = RnTyKiWhat
what, rtke_ctxt :: HsDocContext
rtke_ctxt = HsDocContext
cxt }

isRnKindLevel :: RnTyKiEnv -> Bool
isRnKindLevel :: RnTyKiEnv -> Bool
isRnKindLevel (RTKE { rtke_level :: RnTyKiEnv -> TypeOrKind
rtke_level = TypeOrKind
KindLevel }) = Bool
True
isRnKindLevel RnTyKiEnv
_                                 = Bool
False

--------------
rnModifierContext :: HsDocContext -> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifierContext :: HsDocContext
-> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifierContext HsDocContext
ctxt = RnTyKiEnv
-> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifier (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody)

rnModifiersContext :: HsDocContext -> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiersContext :: HsDocContext
-> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiersContext HsDocContext
ctxt = RnTyKiEnv
-> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiers (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody)

rnModifiersContextAndWarn :: HsDocContext -> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiersContextAndWarn :: HsDocContext
-> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiersContextAndWarn HsDocContext
ctxt = RnTyKiEnv
-> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiersAndWarn (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody)

rnModifierWith :: (mPs -> Maybe mRn)
               -> (mPs -> RnM (mRn, FreeNames))
               -> LHsModifierOf mPs GhcPs
               -> RnM (LHsModifierOf mRn GhcRn, FreeNames)
rnModifierWith :: forall mPs mRn.
(mPs -> Maybe mRn)
-> (mPs -> RnM (mRn, FreeNames))
-> LHsModifierOf mPs GhcPs
-> RnM (LHsModifierOf mRn GhcRn, FreeNames)
rnModifierWith mPs -> Maybe mRn
acceptLiteral1 mPs -> RnM (mRn, FreeNames)
rn (L SrcSpanAnnA
l (HsModifier XModifier GhcPs
_ mPs
ty)) = do
  -- If we see a %1 modifier, and have LinearTypes enabled, treat it the same as
  -- %One. Only %1 counts, not e.g. %01. See #18888. With NoLinearTypes, it's
  -- not special and means the same as %(1 :: Nat), but we still mark it
  -- ModifierPrintsAs1 so that later we can suggest enabling LinearTypes.
  linearEnabled <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.LinearTypes
  case acceptLiteral1 ty of
    Just mRn
literal1Rn
      | Bool
linearEnabled -> (GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn), FreeNames)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn), FreeNames)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsModifierOf mRn GhcRn
-> GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XModifier GhcRn -> mRn -> HsModifierOf mRn GhcRn
forall ty pass. XModifier pass -> ty -> HsModifierOf ty pass
HsModifier XModifier GhcRn
ModifierPrintsAs
ModifierPrintsAs1 mRn
literal1Rn), FreeNames
forall a. Monoid a => a
mempty)
      | Bool
otherwise -> do
          (ty', fns) <- mPs -> RnM (mRn, FreeNames)
rn mPs
ty
          return (L l (HsModifier ModifierPrintsAs1 ty'), fns)
    Maybe mRn
Nothing -> do
      (ty', fns) <- mPs -> RnM (mRn, FreeNames)
rn mPs
ty
      return (L l (HsModifier ModifierPrintsAsSelf ty'), fns)

rnModifier :: RnTyKiEnv -> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifier :: RnTyKiEnv
-> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifier RnTyKiEnv
env =
  (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> Maybe (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> (GenLocated SrcSpanAnnA (HsType GhcPs)
    -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames))
-> LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
-> RnM
     (LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcRn)) GhcRn,
      FreeNames)
forall mPs mRn.
(mPs -> Maybe mRn)
-> (mPs -> RnM (mRn, FreeNames))
-> LHsModifierOf mPs GhcPs
-> RnM (LHsModifierOf mRn GhcRn, FreeNames)
rnModifierWith (\GenLocated SrcSpanAnnA (HsType GhcPs)
ty -> if GenLocated SrcSpanAnnA (HsType GhcPs) -> Bool
forall {l} {pass}. GenLocated l (HsType pass) -> Bool
isLiteral1 GenLocated SrcSpanAnnA (HsType GhcPs)
ty then GenLocated SrcSpanAnnA (HsType GhcRn)
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcRn))
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA (HsType GhcRn)
oneType else Maybe (GenLocated SrcSpanAnnA (HsType GhcRn))
forall a. Maybe a
Nothing)
                 (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env)
  where
    isLiteral1 :: GenLocated l (HsType pass) -> Bool
isLiteral1 GenLocated l (HsType pass)
ty = case GenLocated l (HsType pass)
ty of
      (L l
_ (HsTyLit XTyLit pass
_ (HsNatural XHsNatural pass
_ IntegralLit
il)))
        | SourceText (FastString -> String
unpackFS -> String
"1") <- IntegralLit -> SourceText
il_text IntegralLit
il -> Bool
True
      GenLocated l (HsType pass)
_ -> Bool
False
    oneType :: GenLocated SrcSpanAnnA (HsType GhcRn)
oneType = HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a b. (a -> b) -> a -> b
$ XTyVar GhcRn -> PromotionFlag -> LIdOccP GhcRn -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> LIdOccP pass -> HsType pass
HsTyVar XTyVar GhcRn
forall a. NoAnn a => a
noAnn PromotionFlag
NotPromoted (LIdOccP GhcRn -> HsType GhcRn) -> LIdOccP GhcRn -> HsType GhcRn
forall a b. (a -> b) -> a -> b
$ WithUserRdr Name -> GenLocated SrcSpanAnnN (WithUserRdr Name)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (WithUserRdr Name -> GenLocated SrcSpanAnnN (WithUserRdr Name))
-> WithUserRdr Name -> GenLocated SrcSpanAnnN (WithUserRdr Name)
forall a b. (a -> b) -> a -> b
$ Name -> WithUserRdr Name
noUserRdr Name
oneDataConName

rnModifierAndWarn :: RnTyKiEnv -> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifierAndWarn :: RnTyKiEnv
-> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifierAndWarn RnTyKiEnv
env LHsModifier GhcPs
mod = do
  (mod', fns) <- RnTyKiEnv
-> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifier RnTyKiEnv
env LHsModifier GhcPs
mod
  warn_unrecognised <- woptM Opt_WarnUnrecognisedModifiers
  let (L _ mod''@(HsModifier modPrintsAs _)) = mod'
      suggestLinear = case XModifier GhcRn
modPrintsAs of
        XModifier GhcRn
ModifierPrintsAs
ModifierPrintsAs1 -> SuggestLinear
SuggestLinear
        XModifier GhcRn
ModifierPrintsAs
ModifierPrintsAsSelf -> SuggestLinear
DontSuggestLinear
  diagnosticTc warn_unrecognised $ TcRnUnrecognisedModifier mod'' suggestLinear
  return (mod', fns)

rnModifiersWith :: (LHsModifierOf mPs GhcPs -> RnM (LHsModifierOf mRn GhcRn, FreeNames))
                -> [LHsModifierOf mPs GhcPs]
                -> RnM ([LHsModifierOf mRn GhcRn], FreeNames)
rnModifiersWith :: forall mPs mRn.
(LHsModifierOf mPs GhcPs
 -> RnM (LHsModifierOf mRn GhcRn, FreeNames))
-> [LHsModifierOf mPs GhcPs]
-> RnM ([LHsModifierOf mRn GhcRn], FreeNames)
rnModifiersWith LHsModifierOf mPs GhcPs -> RnM (LHsModifierOf mRn GhcRn, FreeNames)
rnSingle [LHsModifierOf mPs GhcPs]
mods = do
  (mods', fns) <- [(GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn), FreeNames)]
-> ([GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn)], [FreeNames])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip ([(GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn), FreeNames)]
 -> ([GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn)],
     [FreeNames]))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn), FreeNames)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn)], [FreeNames])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenLocated SrcSpanAnnA (HsModifierOf mPs GhcPs)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsModifierOf mPs GhcPs)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [(GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn), FreeNames)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse LHsModifierOf mPs GhcPs -> RnM (LHsModifierOf mRn GhcRn, FreeNames)
GenLocated SrcSpanAnnA (HsModifierOf mPs GhcPs)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsModifierOf mRn GhcRn), FreeNames)
rnSingle [LHsModifierOf mPs GhcPs]
[GenLocated SrcSpanAnnA (HsModifierOf mPs GhcPs)]
mods
  return (mods', mconcat fns)

rnModifiers :: RnTyKiEnv -> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiers :: RnTyKiEnv
-> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiers RnTyKiEnv
env = (LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
 -> RnM
      (LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcRn)) GhcRn,
       FreeNames))
-> [LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs]
-> RnM
     ([LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcRn)) GhcRn],
      FreeNames)
forall mPs mRn.
(LHsModifierOf mPs GhcPs
 -> RnM (LHsModifierOf mRn GhcRn, FreeNames))
-> [LHsModifierOf mPs GhcPs]
-> RnM ([LHsModifierOf mRn GhcRn], FreeNames)
rnModifiersWith (RnTyKiEnv
-> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifier RnTyKiEnv
env)

rnModifiersAndWarn :: RnTyKiEnv -> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiersAndWarn :: RnTyKiEnv
-> [LHsModifier GhcPs] -> RnM ([LHsModifier GhcRn], FreeNames)
rnModifiersAndWarn RnTyKiEnv
env = (LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
 -> RnM
      (LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcRn)) GhcRn,
       FreeNames))
-> [LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs]
-> RnM
     ([LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcRn)) GhcRn],
      FreeNames)
forall mPs mRn.
(LHsModifierOf mPs GhcPs
 -> RnM (LHsModifierOf mRn GhcRn, FreeNames))
-> [LHsModifierOf mPs GhcPs]
-> RnM ([LHsModifierOf mRn GhcRn], FreeNames)
rnModifiersWith (RnTyKiEnv
-> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifierAndWarn RnTyKiEnv
env)

rnLHsType  :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsType :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsType HsDocContext
ctxt LHsType GhcPs
ty = RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody) LHsType GhcPs
ty

rnLHsTypes :: HsDocContext -> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeNames)
rnLHsTypes :: HsDocContext -> HsContext GhcPs -> RnM ([LHsType GhcRn], FreeNames)
rnLHsTypes HsDocContext
doc HsContext GhcPs
tys = (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsType HsDocContext
doc) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys

rnHsConDeclField :: HsDocContext -> HsConDeclField GhcPs
                 -> RnM (HsConDeclField GhcRn, FreeNames)
rnHsConDeclField :: HsDocContext
-> HsConDeclField GhcPs -> RnM (HsConDeclField GhcRn, FreeNames)
rnHsConDeclField HsDocContext
doc = RnTyKiEnv
-> HsConDeclField GhcPs -> RnM (HsConDeclField GhcRn, FreeNames)
rnHsConDeclFieldTyKi (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
doc TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody)

rnHsConDeclFieldTyKi :: RnTyKiEnv -> HsConDeclField GhcPs
                     -> RnM (HsConDeclField GhcRn, FreeNames)
rnHsConDeclFieldTyKi :: RnTyKiEnv
-> HsConDeclField GhcPs -> RnM (HsConDeclField GhcRn, FreeNames)
rnHsConDeclFieldTyKi RnTyKiEnv
env cdf :: HsConDeclField GhcPs
cdf@(CDF { HsModifiedFunArr GhcPs
cdf_multiplicity :: HsModifiedFunArr GhcPs
cdf_multiplicity :: forall pass. HsConDeclField pass -> HsModifiedFunArr pass
cdf_multiplicity, LHsType GhcPs
cdf_type :: LHsType GhcPs
cdf_type :: forall pass. HsConDeclField pass -> LHsType pass
cdf_type, Maybe (LHsDoc GhcPs)
cdf_doc :: Maybe (LHsDoc GhcPs)
cdf_doc :: forall pass. HsConDeclField pass -> Maybe (LHsDoc pass)
cdf_doc }) = do
  (w , fvs_w) <- (LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
 -> RnM
      (LHsModifierOf (GenLocated SrcSpanAnnA (HsType GhcRn)) GhcRn,
       FreeNames))
-> HsModifiedFunArrOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
-> RnM
     (HsModifiedFunArrOf (GenLocated SrcSpanAnnA (HsType GhcRn)) GhcRn,
      FreeNames)
forall multPs multRn.
(LHsModifierOf multPs GhcPs
 -> RnM (LHsModifierOf multRn GhcRn, FreeNames))
-> HsModifiedFunArrOf multPs GhcPs
-> RnM (HsModifiedFunArrOf multRn GhcRn, FreeNames)
rnHsModifiedFunArrWith (RnTyKiEnv
-> LHsModifier GhcPs -> RnM (LHsModifier GhcRn, FreeNames)
rnModifier RnTyKiEnv
env) HsModifiedFunArr GhcPs
HsModifiedFunArrOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs
cdf_multiplicity
  (ty, fvs) <- rnLHsTyKi env cdf_type
  doc <- traverse rnLHsDoc cdf_doc
  return (cdf { cdf_multiplicity = w, cdf_type = ty, cdf_doc = doc }, fvs `plusFN` fvs_w)


rnHsType  :: HsDocContext -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
rnHsType :: HsDocContext -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
rnHsType HsDocContext
ctxt HsType GhcPs
ty = RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
rnHsTyKi (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody) HsType GhcPs
ty

rnLHsKind  :: HsDocContext -> LHsKind GhcPs -> RnM (LHsKind GhcRn, FreeNames)
rnLHsKind :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsKind HsDocContext
ctxt LHsType GhcPs
kind = RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
KindLevel RnTyKiWhat
RnTypeBody) LHsType GhcPs
kind

-- renaming a type only, not a kind
rnLHsTypeArg :: HsDocContext -> LHsTypeArg GhcPs
                -> RnM (LHsTypeArg GhcRn, FreeNames)
rnLHsTypeArg :: HsDocContext
-> LHsTypeArg GhcPs -> RnM (LHsTypeArg GhcRn, FreeNames)
rnLHsTypeArg HsDocContext
ctxt (HsValArg XValArg GhcPs
_ LHsType GhcPs
ty)
   = do { (tys_rn, fvs) <- HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsType HsDocContext
ctxt LHsType GhcPs
ty
        ; return (HsValArg noExtField tys_rn, fvs) }
rnLHsTypeArg HsDocContext
ctxt (HsTypeArg XTypeArg GhcPs
_ LHsType GhcPs
ki)
   = do { (kis_rn, fvs) <- HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsKind HsDocContext
ctxt LHsType GhcPs
ki
        ; return (HsTypeArg noExtField kis_rn, fvs) }
rnLHsTypeArg HsDocContext
_ (HsArgPar XArgPar GhcPs
sp)
   = (HsArg
   GhcRn
   (GenLocated SrcSpanAnnA (HsType GhcRn))
   (GenLocated SrcSpanAnnA (HsType GhcRn)),
 FreeNames)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsArg
        GhcRn
        (GenLocated SrcSpanAnnA (HsType GhcRn))
        (GenLocated SrcSpanAnnA (HsType GhcRn)),
      FreeNames)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XArgPar GhcRn
-> HsArg
     GhcRn
     (GenLocated SrcSpanAnnA (HsType GhcRn))
     (GenLocated SrcSpanAnnA (HsType GhcRn))
forall p tm ty. XArgPar p -> HsArg p tm ty
HsArgPar XArgPar GhcPs
XArgPar GhcRn
sp, FreeNames
emptyFNs)

rnLHsTypeArgs :: HsDocContext -> [LHsTypeArg GhcPs]
                 -> RnM ([LHsTypeArg GhcRn], FreeNames)
rnLHsTypeArgs :: HsDocContext
-> [LHsTypeArg GhcPs] -> RnM ([LHsTypeArg GhcRn], FreeNames)
rnLHsTypeArgs HsDocContext
doc [LHsTypeArg GhcPs]
args = (HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (HsArg
         GhcRn
         (GenLocated SrcSpanAnnA (HsType GhcRn))
         (GenLocated SrcSpanAnnA (HsType GhcRn)),
       FreeNames))
-> [HsArg
      GhcPs
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> RnM
     ([HsArg
         GhcRn
         (GenLocated SrcSpanAnnA (HsType GhcRn))
         (GenLocated SrcSpanAnnA (HsType GhcRn))],
      FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (HsDocContext
-> LHsTypeArg GhcPs -> RnM (LHsTypeArg GhcRn, FreeNames)
rnLHsTypeArg HsDocContext
doc) [LHsTypeArg GhcPs]
[HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
args

--------------
rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs
              -> RnM (LHsContext GhcRn, FreeNames)
rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeNames)
rnTyKiContext RnTyKiEnv
env (L SrcSpanAnnC
loc [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt)
  = do { String -> SDoc -> TcRn ()
traceRn String
"rncontext" ([GenLocated SrcSpanAnnA (HsType GhcPs)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt)
       ; let env' :: RnTyKiEnv
env' = RnTyKiEnv
env { rtke_what = RnConstraint }
       ; (cxt', fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env') [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt
       ; return (L loc cxt', fvs) }

rnContext :: HsDocContext -> LHsContext GhcPs
          -> RnM (LHsContext GhcRn, FreeNames)
rnContext :: HsDocContext
-> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeNames)
rnContext HsDocContext
doc LHsContext GhcPs
theta = RnTyKiEnv -> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeNames)
rnTyKiContext (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
doc TypeOrKind
TypeLevel RnTyKiWhat
RnConstraint) LHsContext GhcPs
theta

rnMaybeContext :: HsDocContext -> Maybe (LHsContext GhcPs)
          -> RnM (Maybe (LHsContext GhcRn), FreeNames)
rnMaybeContext :: HsDocContext
-> Maybe (LHsContext GhcPs)
-> RnM (Maybe (LHsContext GhcRn), FreeNames)
rnMaybeContext HsDocContext
_ Maybe (LHsContext GhcPs)
Nothing = (Maybe
   (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]),
 FreeNames)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Maybe
        (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]),
      FreeNames)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)])
forall a. Maybe a
Nothing, FreeNames
emptyFNs)
rnMaybeContext HsDocContext
doc (Just LHsContext GhcPs
theta)
  = do { (theta', fvs) <- HsDocContext
-> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeNames)
rnContext HsDocContext
doc LHsContext GhcPs
theta
       ; return (Just theta', fvs)
       }


--------------
rnLHsTyKi  :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env (L SrcSpanAnnA
loc HsType GhcPs
ty)
  = SrcSpanAnnA
-> RnM (LHsType GhcRn, FreeNames) -> RnM (LHsType GhcRn, FreeNames)
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (RnM (LHsType GhcRn, FreeNames) -> RnM (LHsType GhcRn, FreeNames))
-> RnM (LHsType GhcRn, FreeNames) -> RnM (LHsType GhcRn, FreeNames)
forall a b. (a -> b) -> a -> b
$
    do { (ty', fvs) <- RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
rnHsTyKi RnTyKiEnv
env HsType GhcPs
ty
       ; return (L loc ty', fvs) }

rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)

rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllTelescope GhcPs
tele, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
tau })
  = do { RnTyKiEnv -> HsTypeOrSigType GhcPs -> TcRn ()
checkPolyKinds RnTyKiEnv
env (HsType GhcPs -> HsTypeOrSigType GhcPs
forall p. HsType p -> HsTypeOrSigType p
HsType HsType GhcPs
ty)
       ; HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeNames))
-> RnM (HsType GhcRn, FreeNames)
forall a.
HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
bindHsForAllTelescope (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) HsForAllTelescope GhcPs
tele ((HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeNames))
 -> RnM (HsType GhcRn, FreeNames))
-> (HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeNames))
-> RnM (HsType GhcRn, FreeNames)
forall a b. (a -> b) -> a -> b
$ \ HsForAllTelescope GhcRn
tele' ->
    do { (tau',  fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
tau
       ; return ( HsForAllTy { hst_xforall = noExtField
                             , hst_tele = tele' , hst_body =  tau' }
                , fvs) } }

rnHsTyKi RnTyKiEnv
env (HsQualTy { hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_ctxt = LHsContext GhcPs
lctxt, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
tau })
  = do { -- no need to check type vs kind level here; this is
         -- checked in the type checker. See
         -- Note [No constraints in kinds] in GHC.Tc.Validity
         (ctxt', fvs1) <- RnTyKiEnv -> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeNames)
rnTyKiContext RnTyKiEnv
env LHsContext GhcPs
lctxt
       ; (tau',  fvs2) <- rnLHsTyKi env tau
       ; return (HsQualTy { hst_xqual = noExtField, hst_ctxt = ctxt'
                          , hst_body =  tau' }
                , fvs1 `plusFN` fvs2) }

rnHsTyKi RnTyKiEnv
env tv :: HsType GhcPs
tv@(HsTyVar XTyVar GhcPs
_ PromotionFlag
ip (L SrcSpanAnnN
loc RdrName
rdr_name))
  = do { Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env Bool -> Bool -> Bool
&& RdrName -> Bool
isRdrTyVar RdrName
rdr_name) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
         Extension -> TcRn () -> TcRn ()
forall gbl lcl. Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
unlessXOptM Extension
LangExt.PolyKinds (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$
         HsDocContext -> TcRnMessage -> TcRnMessage
TcRnWithHsDocContext (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) (TcRnMessage -> TcRnMessage) -> TcRnMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
         RdrName -> TcRnMessage
TcRnUnexpectedKindVar RdrName
rdr_name
           -- Any type variable at the kind level is illegal without the use
           -- of PolyKinds (see #14710)
       ; gre <- RnTyKiEnv -> RdrName -> RnM GlobalRdrElt
rnTyVar RnTyKiEnv
env RdrName
rdr_name
       ; this_mod <- getModule
       ; explicit_level_imports <- xoptM LangExt.ExplicitLevelImports
       ; let loc_gre_with_rdr = SrcSpanAnnN
-> WithUserRdr GlobalRdrElt
-> GenLocated SrcSpanAnnN (WithUserRdr GlobalRdrElt)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc (WithUserRdr GlobalRdrElt
 -> GenLocated SrcSpanAnnN (WithUserRdr GlobalRdrElt))
-> WithUserRdr GlobalRdrElt
-> GenLocated SrcSpanAnnN (WithUserRdr GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ RdrName -> GlobalRdrElt -> WithUserRdr GlobalRdrElt
forall a. RdrName -> a -> WithUserRdr a
WithUserRdr RdrName
rdr_name GlobalRdrElt
gre
             name = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
       ; if  | explicit_level_imports
             -- See Note [Strict level checks with ExplicitLevelImports]
             -> checkThLocalNameNoLift loc_gre_with_rdr

             | nameIsLocalOrFrom this_mod name
             -> checkThLocalTyName gre

             | otherwise -> pure ()
       ; checkPromotedDataConName env tv Prefix ip $ greName gre
       ; return (HsTyVar noAnn ip $ fmap greName <$> loc_gre_with_rdr, unitFN name) }

rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsOpTy XOpTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
tyop LHsType GhcPs
ty2)
  = SrcSpan
-> RnM (HsType GhcRn, FreeNames) -> RnM (HsType GhcRn, FreeNames)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
tyop) (RnM (HsType GhcRn, FreeNames) -> RnM (HsType GhcRn, FreeNames))
-> RnM (HsType GhcRn, FreeNames) -> RnM (HsType GhcRn, FreeNames)
forall a b. (a -> b) -> a -> b
$
    do  { (tyop', fvs1) <- RnTyKiEnv
-> HsType GhcPs -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnHsTyOp RnTyKiEnv
env HsType GhcPs
ty LHsType GhcPs
tyop
        ; fix <- lookupTypeFixityRn tyop'
        ; (ty1', fvs2) <- rnLHsTyKi env ty1
        ; (ty2', fvs3) <- rnLHsTyKi env ty2
        ; res_ty <- mkHsOpTyRn tyop' fix ty1' ty2'
        ; return (res_ty, plusFNs [fvs1, fvs2, fvs3]) }

rnHsTyKi RnTyKiEnv
env (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty)
  = do { (ty', fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; return (HsParTy noAnn ty', fvs) }

rnHsTyKi RnTyKiEnv
env (HsFunTy XFunTy GhcPs
u HsModifiedFunArr GhcPs
mult LHsType GhcPs
ty1 LHsType GhcPs
ty2)
  = do { (ty1', fvs1) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty1
       ; (ty2', fvs2) <- rnLHsTyKi env ty2
       ; (mult', w_fvs) <- rnHsModifiedFunArrWith (rnModifier env) mult
       ; return (HsFunTy u mult' ty1' ty2'
                , plusFNs [fvs1, fvs2, w_fvs]) }

rnHsTyKi RnTyKiEnv
env listTy :: HsType GhcPs
listTy@(HsListTy XListTy GhcPs
x LHsType GhcPs
ty)
  = do { Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
           RnTyKiEnv -> HsType GhcPs -> TcRn ()
checkDataKinds RnTyKiEnv
env HsType GhcPs
listTy
       ; (ty', fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; return (HsListTy x ty', fvs) }

rnHsTyKi RnTyKiEnv
env (HsKindSig XKindSig GhcPs
x LHsType GhcPs
ty LHsType GhcPs
k)
  = do { kind_sigs_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.KindSignatures
       ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) k)
       ; (k', sig_fvs)  <- rnLHsTyKi (env { rtke_level = KindLevel }) k
       ; (ty', lhs_fvs) <- bindSigTyVarsFV (hsScopedKvs k') $
                           rnLHsTyKi env ty
       ; return (HsKindSig x ty' k', lhs_fvs `plusFN` sig_fvs) }

-- Unboxed tuples are allowed to have poly-typed arguments.  These
-- sometimes crop up as a result of CPR worker-wrappering dictionaries.
rnHsTyKi RnTyKiEnv
env tupleTy :: HsType GhcPs
tupleTy@(HsTupleTy XTupleTy GhcPs
x HsTupleSort
tup_con HsContext GhcPs
tys)
  = do { Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
           RnTyKiEnv -> HsType GhcPs -> TcRn ()
checkDataKinds RnTyKiEnv
env HsType GhcPs
tupleTy
       ; (tys', fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
       ; return (HsTupleTy x tup_con tys', fvs) }

rnHsTyKi RnTyKiEnv
env sumTy :: HsType GhcPs
sumTy@(HsSumTy XSumTy GhcPs
x HsContext GhcPs
tys)
  = do { Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
           RnTyKiEnv -> HsType GhcPs -> TcRn ()
checkDataKinds RnTyKiEnv
env HsType GhcPs
sumTy
       ; (tys', fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
       ; return (HsSumTy x tys', fvs) }

rnHsTyKi RnTyKiEnv
env tyLit :: HsType GhcPs
tyLit@(HsTyLit XTyLit GhcPs
src HsLit GhcPs
lit)
  = do { RnTyKiEnv -> HsType GhcPs -> TcRn ()
checkDataKinds RnTyKiEnv
env HsType GhcPs
tyLit
       ; (HsType GhcRn, FreeNames) -> RnM (HsType GhcRn, FreeNames)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XTyLit GhcRn -> HsLit GhcRn -> HsType GhcRn
forall pass. XTyLit pass -> HsLit pass -> HsType pass
HsTyLit XTyLit GhcPs
XTyLit GhcRn
src (HsLit GhcPs -> HsLit GhcRn
forall (p :: Pass) (p' :: Pass).
(XXLit (GhcPass p) ~ DataConCantHappen) =>
HsLit (GhcPass p) -> HsLit (GhcPass p')
convertLit HsLit GhcPs
lit), FreeNames
emptyFNs) }

rnHsTyKi RnTyKiEnv
env (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2)
  = do { (ty1', fvs1) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty1
       ; (ty2', fvs2) <- rnLHsTyKi env ty2
       ; return (HsAppTy noExtField ty1' ty2', fvs1 `plusFN` fvs2) }

rnHsTyKi RnTyKiEnv
env (HsAppKindTy XAppKindTy GhcPs
_ LHsType GhcPs
ty LHsType GhcPs
k)
  = do { kind_app <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeApplications
       ; unless kind_app (addErr (typeAppErr KindLevel k))
       ; (ty', fvs1) <- rnLHsTyKi env ty
       ; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k
       ; return (HsAppKindTy noExtField ty' k', fvs1 `plusFN` fvs2) }

rnHsTyKi RnTyKiEnv
env t :: HsType GhcPs
t@(HsIParamTy XIParamTy GhcPs
x XRec GhcPs HsIPName
n LHsType GhcPs
ty)
  = do { RnTyKiEnv -> HsType GhcPs -> TcRn ()
notInKinds RnTyKiEnv
env HsType GhcPs
t
       ; (ty', fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; return (HsIParamTy x n ty', fvs) }

rnHsTyKi RnTyKiEnv
_ (HsStarTy XStarTy GhcPs
x)
  = (HsType GhcRn, FreeNames) -> RnM (HsType GhcRn, FreeNames)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XStarTy GhcRn -> HsType GhcRn
forall pass. XStarTy pass -> HsType pass
HsStarTy XStarTy GhcPs
XStarTy GhcRn
x, FreeNames
emptyFNs)

rnHsTyKi RnTyKiEnv
_ (HsSpliceTy XSpliceTy GhcPs
_ HsUntypedSplice GhcPs
sp)
  = HsUntypedSplice GhcPs -> RnM (HsType GhcRn, FreeNames)
rnSpliceType HsUntypedSplice GhcPs
sp

rnHsTyKi RnTyKiEnv
env (HsDocTy XDocTy GhcPs
x LHsType GhcPs
ty LHsDoc GhcPs
haddock_doc)
  = do { (ty', fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; haddock_doc' <- rnLHsDoc haddock_doc
       ; return (HsDocTy x ty' haddock_doc', fvs) }

-- See Note [Renaming HsCoreTys]
rnHsTyKi RnTyKiEnv
env (XHsType (HsCoreTy HsCoreTy
ty))
  = do (Name -> TcRn ()) -> [Name] -> TcRn ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RdrName -> TcRn ()
check_in_scope (RdrName -> TcRn ()) -> (Name -> RdrName) -> Name -> TcRn ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> RdrName
nameRdrName) [Name]
fvs_list
       (HsType GhcRn, FreeNames) -> RnM (HsType GhcRn, FreeNames)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XXType GhcRn -> HsType GhcRn
forall pass. XXType pass -> HsType pass
XHsType XXType GhcRn
HsCoreTy
ty, FreeNames
fvs)
  where
    fvs_list :: [Name]
fvs_list = (TyCoVar -> Name) -> [TyCoVar] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVar -> Name
forall a. NamedThing a => a -> Name
getName ([TyCoVar] -> [Name]) -> [TyCoVar] -> [Name]
forall a b. (a -> b) -> a -> b
$ HsCoreTy -> [TyCoVar]
tyCoVarsOfTypeList HsCoreTy
ty
    fvs :: FreeNames
fvs = [Name] -> FreeNames
mkFNs [Name]
fvs_list

    check_in_scope :: RdrName -> RnM ()
    check_in_scope :: RdrName -> TcRn ()
check_in_scope RdrName
rdr_name = do
      mb_name <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
      when (isNothing mb_name) $
        addErr $
          TcRnWithHsDocContext (rtke_ctxt env) $
            TcRnNotInScope (notInScopeErr WL_LocalOnly rdr_name) rdr_name

rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(XHsType (HsBangTy (EpaLocation, EpToken "#-}", EpaLocation)
_ HsSrcBang
bang (L SrcSpanAnnA
_ HsType GhcPs
inner))) = do
  -- While top-level bangs at this point are eliminated (eg !(Maybe Int)),
  -- other kinds of bangs are not (eg ((!Maybe) Int)). These kinds of
  -- bangs are invalid, so fail. (#7210, #14761)
  TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$
    HsDocContext -> TcRnMessage -> TcRnMessage
TcRnWithHsDocContext (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) (TcRnMessage -> TcRnMessage) -> TcRnMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
      HsType GhcPs -> HsSrcBang -> TcRnMessage
TcRnUnexpectedAnnotation HsType GhcPs
ty HsSrcBang
bang
  RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeNames)
rnHsTyKi RnTyKiEnv
env HsType GhcPs
inner

rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(XHsType (HsRecTy {})) = do
  -- Record types (which only show up temporarily in constructor
  -- signatures) should have been removed by now
  TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$
    HsDocContext -> TcRnMessage -> TcRnMessage
TcRnWithHsDocContext (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) (TcRnMessage -> TcRnMessage) -> TcRnMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
      HsType GhcPs -> TcRnMessage
TcRnIllegalRecordSyntax HsType GhcPs
ty
  (HsType GhcRn, FreeNames) -> RnM (HsType GhcRn, FreeNames)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XWildCardTy GhcRn -> HsType GhcRn
forall pass. XWildCardTy pass -> HsType pass
HsWildCardTy XWildCardTy GhcRn
NoExtField
noExtField, FreeNames
emptyFNs) -- trick to avoid `failWithTc`

rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsExplicitListTy XExplicitListTy GhcPs
_ PromotionFlag
ip HsContext GhcPs
tys)
  = do { RnTyKiEnv -> HsType GhcPs -> TcRn ()
checkDataKinds RnTyKiEnv
env HsType GhcPs
ty
       ; (tys', fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
       ; unless (isPromoted ip) $
           addDiagnostic (TcRnUntickedPromotedThing $ UntickedExplicitList)
       ; return (HsExplicitListTy noExtField ip tys', fvs) }

rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsExplicitTupleTy XExplicitTupleTy GhcPs
_ PromotionFlag
ip HsContext GhcPs
tys)
  = do { RnTyKiEnv -> HsType GhcPs -> TcRn ()
checkDataKinds RnTyKiEnv
env HsType GhcPs
ty
       ; (tys', fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
       ; return (HsExplicitTupleTy noExtField ip tys', fvs) }

rnHsTyKi RnTyKiEnv
env (HsWildCardTy XWildCardTy GhcPs
_)
  = do { RnTyKiEnv -> TcRn ()
checkAnonWildCard RnTyKiEnv
env
       ; (HsType GhcRn, FreeNames) -> RnM (HsType GhcRn, FreeNames)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XWildCardTy GhcRn -> HsType GhcRn
forall pass. XWildCardTy pass -> HsType pass
HsWildCardTy XWildCardTy GhcRn
NoExtField
noExtField, FreeNames
emptyFNs) }

{-
Note [Strict level checks with ExplicitLevelImports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Since the proposed change specification of `ExplicitLevelImports` [1] talks about
all identifiers as if they were created equally in the context of TemplateHaskell,
we want to adhere to that specification and at the same time use this unique
chance of being able to guard the "correct" behaviour behind an extension, without
breaking too many users. That is why, if ExplicitLevelImports is on, we
- do not allow non-well-levelled types to be imported
- do not allow locally defined type names to be used in an ill-levelled way, more
  most importantly, we do not allow locally defined names to be used in quotes.

When doing level checks, we historically have been glancing over some
not-well-levelled programs - e.g. the following program was historically
accepted from the perspective of the stage restriction:

type T = ExpQ
x = $(_ :: T)

However, when type-checking the splice `$(_ :: T)`, we found that `T`
had not yet been made part of the type-checking environment - we would
insert an ad-hoc check in `notFound` which would report the staging error.

See Note [Out of scope might be a staging error]

This is obviously not very rigorous - our "specification" of a program
being well-staged becomes "if the type checker needs the thing to be in scope
and it is not, the program is not well-staged, otherwise it is".

[1]: https://github.com/ghc-proposals/ghc-proposals/blob/8e4d0e9340c04b904373f9dfe5cbcebc354cd01f/proposals/0682-explicit-level-imports.rst
-}

rnHsModifiedFunArrWith :: (LHsModifierOf multPs GhcPs -> RnM (LHsModifierOf multRn GhcRn, FreeNames))
                       -> HsModifiedFunArrOf multPs GhcPs
                       -> RnM (HsModifiedFunArrOf multRn GhcRn, FreeNames)
rnHsModifiedFunArrWith :: forall multPs multRn.
(LHsModifierOf multPs GhcPs
 -> RnM (LHsModifierOf multRn GhcRn, FreeNames))
-> HsModifiedFunArrOf multPs GhcPs
-> RnM (HsModifiedFunArrOf multRn GhcRn, FreeNames)
rnHsModifiedFunArrWith LHsModifierOf multPs GhcPs
-> RnM (LHsModifierOf multRn GhcRn, FreeNames)
rn (HsModifiedFunArr XHsModifiedFunArr multPs GhcPs
_ [LHsModifierOf multPs GhcPs]
mods HsFunArr GhcPs
arr) = do
  (mods', fns) <- (LHsModifierOf multPs GhcPs
 -> RnM (LHsModifierOf multRn GhcRn, FreeNames))
-> [LHsModifierOf multPs GhcPs]
-> RnM ([LHsModifierOf multRn GhcRn], FreeNames)
forall mPs mRn.
(LHsModifierOf mPs GhcPs
 -> RnM (LHsModifierOf mRn GhcRn, FreeNames))
-> [LHsModifierOf mPs GhcPs]
-> RnM ([LHsModifierOf mRn GhcRn], FreeNames)
rnModifiersWith LHsModifierOf multPs GhcPs
-> RnM (LHsModifierOf multRn GhcRn, FreeNames)
rn [LHsModifierOf multPs GhcPs]
mods
  let modArr' = XHsModifiedFunArr multRn GhcRn
-> [LHsModifierOf multRn GhcRn]
-> HsFunArr GhcRn
-> HsModifiedFunArrOf multRn GhcRn
forall mult pass.
XHsModifiedFunArr mult pass
-> [LHsModifierOf mult pass]
-> HsFunArr pass
-> HsModifiedFunArrOf mult pass
HsModifiedFunArr NoExtField
XHsModifiedFunArr multRn GhcRn
noExtField [LHsModifierOf multRn GhcRn]
[GenLocated SrcSpanAnnA (HsModifierOf multRn GhcRn)]
mods' (HsFunArr GhcRn -> HsModifiedFunArrOf multRn GhcRn)
-> HsFunArr GhcRn -> HsModifiedFunArrOf multRn GhcRn
forall a b. (a -> b) -> a -> b
$ case HsFunArr GhcPs
arr of
        HsStandardArr XHsStandardArr GhcPs
_ -> XHsStandardArr GhcRn -> HsFunArr GhcRn
forall pass. XHsStandardArr pass -> HsFunArr pass
HsStandardArr NoExtField
XHsStandardArr GhcRn
noExtField
        HsLinearArr XHsLinearArr GhcPs
_ -> XHsLinearArr GhcRn -> HsFunArr GhcRn
forall pass. XHsLinearArr pass -> HsFunArr pass
HsLinearArr NoExtField
XHsLinearArr GhcRn
noExtField
  pure (modArr', fns)

{-
Note [Renaming HsCoreTys]
~~~~~~~~~~~~~~~~~~~~~~~~~
HsCoreTy is an escape hatch that allows embedding Core Types in HsTypes.
As such, there's not much to be done in order to rename an HsCoreTy,
since it's already been renamed to some extent. However, in an attempt to
detect ill-formed HsCoreTys, the renamer checks to see if all free type
variables in an HsCoreTy are in scope. To see why this can matter, consider
this example from #18914:

  type T f = forall a. f a

  class C f where
    m :: T f

  newtype N f a = MkN (f a)
    deriving C

Because of #18914, a previous GHC would generate the following code:

  instance C f => C (N f) where
    m :: T (N f)
    m = coerce @(f a)   -- The type within @(...) is an HsCoreTy
               @(N f a) -- So is this
               (m @f)

There are two HsCoreTys in play—(f a) and (N f a)—both of which have
`f` and `a` as free type variables. The `f` is in scope from the instance head,
but `a` is completely unbound, which is what led to #18914. To avoid this sort
of mistake going forward, the renamer will now detect that `a` is unbound and
throw an error accordingly.
-}

--------------
rnTyVar :: RnTyKiEnv -> RdrName -> RnM GlobalRdrElt
rnTyVar :: RnTyKiEnv -> RdrName -> RnM GlobalRdrElt
rnTyVar RnTyKiEnv
env RdrName
rdr_name
  = do { gre <- RdrName -> RnM GlobalRdrElt
lookupTypeOccRn RdrName
rdr_name
       ; checkNamedWildCard env $ greName gre
       ; return gre }

rnLTyVar :: LocatedN RdrName -> RnM (LocatedN GlobalRdrElt)
-- Called externally; does not deal with wildcards
rnLTyVar :: GenLocated SrcSpanAnnN RdrName -> RnM (LocatedN GlobalRdrElt)
rnLTyVar (L SrcSpanAnnN
loc RdrName
rdr_name)
  = do { tyvar <- RdrName -> RnM GlobalRdrElt
lookupTypeOccRn RdrName
rdr_name
       ; return (L loc tyvar) }

--------------
rnHsTyOp :: RnTyKiEnv -> HsType GhcPs -> LHsType GhcPs
         -> RnM (LHsType GhcRn, FreeNames)
rnHsTyOp :: RnTyKiEnv
-> HsType GhcPs -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnHsTyOp RnTyKiEnv
env HsType GhcPs
overall_ty LHsType GhcPs
tyop
  | L SrcSpanAnnA
l (HsTyVar XTyVar GhcPs
ann PromotionFlag
prom (L SrcSpanAnnN
loc RdrName
op)) <- LHsType GhcPs
tyop
  = do { opgre <- RnTyKiEnv -> RdrName -> RnM GlobalRdrElt
rnTyVar RnTyKiEnv
env RdrName
op
       ; let opName = GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
opgre
       ; unlessXOptM LangExt.TypeOperators $
           if opName `hasKey` eqTyConKey -- See [eqTyCon (~) compatibility fallback] in GHC.Rename.Env
           then addDiagnostic TcRnTypeEqualityRequiresOperators
           else addErr $ TcRnIllegalTypeOperator (ppr overall_ty) op
       ; checkPromotedDataConName env overall_ty Infix prom opName
       ; let tyop' = SrcSpanAnnA
-> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XTyVar GhcRn -> PromotionFlag -> LIdOccP GhcRn -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> LIdOccP pass -> HsType pass
HsTyVar XTyVar GhcPs
XTyVar GhcRn
ann PromotionFlag
prom (SrcSpanAnnN
-> WithUserRdr Name -> GenLocated SrcSpanAnnN (WithUserRdr Name)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc (RdrName -> Name -> WithUserRdr Name
forall a. RdrName -> a -> WithUserRdr a
WithUserRdr RdrName
op Name
opName)))
       ; return (tyop', unitFN opName) }
  | Bool
otherwise
  = RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeNames)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
tyop

--------------
checkWildCard :: RnTyKiEnv
              -> Maybe Name -- ^ name of the wildcard,
                            -- or 'Nothing' for an anonymous wildcard
              -> Maybe BadAnonWildcardContext
              -> RnM ()
checkWildCard :: RnTyKiEnv -> Maybe Name -> Maybe BadAnonWildcardContext -> TcRn ()
checkWildCard RnTyKiEnv
env Maybe Name
mb_name (Just BadAnonWildcardContext
bad)
  = TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ HsDocContext -> TcRnMessage -> TcRnMessage
TcRnWithHsDocContext (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) (TcRnMessage -> TcRnMessage) -> TcRnMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
             Maybe Name -> BadAnonWildcardContext -> TcRnMessage
TcRnIllegalWildcardInType Maybe Name
mb_name BadAnonWildcardContext
bad
checkWildCard RnTyKiEnv
_ Maybe Name
_ Maybe BadAnonWildcardContext
Nothing
  = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkAnonWildCard :: RnTyKiEnv -> RnM ()
-- Report an error if an anonymous wildcard is illegal here
checkAnonWildCard :: RnTyKiEnv -> TcRn ()
checkAnonWildCard RnTyKiEnv
env
  = RnTyKiEnv -> Maybe Name -> Maybe BadAnonWildcardContext -> TcRn ()
checkWildCard RnTyKiEnv
env Maybe Name
forall a. Maybe a
Nothing Maybe BadAnonWildcardContext
mb_bad
  where
    mb_bad :: Maybe BadAnonWildcardContext
    mb_bad :: Maybe BadAnonWildcardContext
mb_bad | Bool -> Bool
not (RnTyKiEnv -> Bool
wildCardsAllowed RnTyKiEnv
env)
           = BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a. a -> Maybe a
Just BadAnonWildcardContext
WildcardsNotAllowedAtAll
           | Bool
otherwise
           = case RnTyKiEnv -> RnTyKiWhat
rtke_what RnTyKiEnv
env of
               RnTyKiWhat
RnTypeBody      -> Maybe BadAnonWildcardContext
forall a. Maybe a
Nothing
               RnTyKiWhat
RnTopConstraint -> BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a. a -> Maybe a
Just BadAnonWildcardContext
WildcardNotLastInConstraint
               RnTyKiWhat
RnConstraint    -> BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a. a -> Maybe a
Just BadAnonWildcardContext
WildcardNotLastInConstraint

checkNamedWildCard :: RnTyKiEnv -> Name -> RnM ()
-- Report an error if a named wildcard is illegal here
checkNamedWildCard :: RnTyKiEnv -> Name -> TcRn ()
checkNamedWildCard RnTyKiEnv
env Name
name
  = RnTyKiEnv -> Maybe Name -> Maybe BadAnonWildcardContext -> TcRn ()
checkWildCard RnTyKiEnv
env (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
name) Maybe BadAnonWildcardContext
mb_bad
  where
    mb_bad :: Maybe BadAnonWildcardContext
mb_bad | Bool -> Bool
not (Name
name Name -> FreeNames -> Bool
`elemNameSet` RnTyKiEnv -> FreeNames
rtke_nwcs RnTyKiEnv
env)
           = Maybe BadAnonWildcardContext
forall a. Maybe a
Nothing  -- Not a wildcard
           | Bool -> Bool
not (RnTyKiEnv -> Bool
wildCardsAllowed RnTyKiEnv
env)
           = BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a. a -> Maybe a
Just BadAnonWildcardContext
WildcardsNotAllowedAtAll
           | Bool
otherwise
           = case RnTyKiEnv -> RnTyKiWhat
rtke_what RnTyKiEnv
env of
               RnTyKiWhat
RnTypeBody      -> Maybe BadAnonWildcardContext
forall a. Maybe a
Nothing   -- Allowed
               RnTyKiWhat
RnTopConstraint -> Maybe BadAnonWildcardContext
forall a. Maybe a
Nothing   -- Allowed; e.g.
                  -- f :: (Eq _a) => _a -> Int
                  -- g :: (_a, _b) => T _a _b -> Int
                  -- The named tyvars get filled in from elsewhere
               RnTyKiWhat
RnConstraint    -> BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a. a -> Maybe a
Just BadAnonWildcardContext
WildcardNotLastInConstraint

wildCardsAllowed :: RnTyKiEnv -> Bool
-- ^ In what contexts are wildcards permitted
wildCardsAllowed :: RnTyKiEnv -> Bool
wildCardsAllowed RnTyKiEnv
env
   = case RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env of
       TypeSigCtx {}       -> Bool
True
       TypBrCtx {}         -> Bool
True   -- Template Haskell quoted type
       SpliceTypeCtx {}    -> Bool
True   -- Result of a Template Haskell splice
       ExprWithTySigCtx {} -> Bool
True
       PatCtx {}           -> Bool
True
       RuleCtx {}          -> Bool
True
       SpecECtx {}         -> Bool
True
       FamPatCtx {}        -> Bool
True   -- Not named wildcards though
       GHCiCtx {}          -> Bool
True
       HsTypeCtx {}        -> Bool
True
       StandaloneKindSigCtx {} -> Bool
False  -- See Note [Wildcards in standalone kind signatures] in "GHC.Hs.Decls"
       HsDocContext
_                   -> Bool
False



---------------
-- | Ensures either that we're in a type or that -XPolyKinds is set
checkPolyKinds :: RnTyKiEnv
               -> HsTypeOrSigType GhcPs
               -> RnM ()
checkPolyKinds :: RnTyKiEnv -> HsTypeOrSigType GhcPs -> TcRn ()
checkPolyKinds RnTyKiEnv
env HsTypeOrSigType GhcPs
ty
  | RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env
  = do { polykinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.PolyKinds
       ; unless polykinds $
         addErr $ TcRnIllegalKind ty True }
checkPolyKinds RnTyKiEnv
_ HsTypeOrSigType GhcPs
_ = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

notInKinds :: RnTyKiEnv
           -> HsType GhcPs
           -> RnM ()
notInKinds :: RnTyKiEnv -> HsType GhcPs -> TcRn ()
notInKinds RnTyKiEnv
env HsType GhcPs
ty
  | RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env
  = TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ HsTypeOrSigType GhcPs -> Bool -> TcRnMessage
TcRnIllegalKind (HsType GhcPs -> HsTypeOrSigType GhcPs
forall p. HsType p -> HsTypeOrSigType p
HsType HsType GhcPs
ty) Bool
False
notInKinds RnTyKiEnv
_ HsType GhcPs
_ = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{- *****************************************************
*                                                      *
          Binding type variables
*                                                      *
***************************************************** -}

bindSigTyVarsFV :: [Name]
                -> RnM (a, FreeNames)
                -> RnM (a, FreeNames)
-- Used just before renaming the defn of a function
-- with a separate type signature, to bring its tyvars into scope
-- With no -XScopedTypeVariables, this is a no-op
bindSigTyVarsFV :: forall a. [Name] -> RnM (a, FreeNames) -> RnM (a, FreeNames)
bindSigTyVarsFV [Name]
tvs RnM (a, FreeNames)
thing_inside
  = do  { scoped_tyvars <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.ScopedTypeVariables
        ; if not scoped_tyvars then
                thing_inside
          else
                bindLocalNamesFV tvs thing_inside }

---------------
bindHsQTyVars :: forall a b.
                 HsDocContext
              -> Maybe (a, [Name])  -- Just _  => an associated type decl
              -> FreeKiTyVars       -- Kind variables from scope
              -> LHsQTyVars GhcPs
              -> (LHsQTyVars GhcRn -> FreeKiTyVars -> RnM (b, FreeNames))
                  -- The FreeKiTyVars is null <=> all kind variables used in the
                  -- kind signature are bound on the left.  Reason:
                  -- the last clause of Note [CUSKs: complete user-supplied kind signatures]
                  -- in GHC.Hs.Decls
              -> RnM (b, FreeNames)

-- See Note [bindHsQTyVars examples]
-- (a) Bring kind variables into scope
--     both (i)  passed in body_kv_occs
--     and  (ii) mentioned in the kinds of hsq_bndrs
-- (b) Bring type variables into scope
--
bindHsQTyVars :: forall a b.
HsDocContext
-> Maybe (a, [Name])
-> FreeKiTyVars
-> LHsQTyVars GhcPs
-> (LHsQTyVars GhcRn -> FreeKiTyVars -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
bindHsQTyVars HsDocContext
doc Maybe (a, [Name])
mb_assoc FreeKiTyVars
body_kv_occs LHsQTyVars GhcPs
hsq_bndrs LHsQTyVars GhcRn -> FreeKiTyVars -> RnM (b, FreeNames)
thing_inside
  = do { let bndr_kv_occs :: FreeKiTyVars
bndr_kv_occs = [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs] -> FreeKiTyVars
forall flag. [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
extractHsTyVarBndrsKVs [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
hs_tv_bndrs

       ; let -- See Note [bindHsQTyVars examples] for what
             -- all these various things are doing
             bndrs, all_implicit_kvs :: [LocatedN RdrName]
             bndrs :: FreeKiTyVars
bndrs        = (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
 -> Maybe (GenLocated SrcSpanAnnN RdrName))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> FreeKiTyVars
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LHsTyVarBndr (HsBndrVis GhcPs) GhcPs
-> Maybe (LocatedN (IdP GhcPs))
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> Maybe (GenLocated SrcSpanAnnN RdrName)
forall (p :: Pass) flag.
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsTyVarBndr flag (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
hsLTyVarLocName [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
hs_tv_bndrs
             all_implicit_kvs :: FreeKiTyVars
all_implicit_kvs = FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
filterFreeNamesToBind FreeKiTyVars
bndrs (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
               FreeKiTyVars
bndr_kv_occs FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
forall a. [a] -> [a] -> [a]
++ FreeKiTyVars
body_kv_occs
             body_remaining :: FreeKiTyVars
body_remaining = FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
filterFreeNamesToBind FreeKiTyVars
bndr_kv_occs (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
              FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
filterFreeNamesToBind FreeKiTyVars
bndrs FreeKiTyVars
body_kv_occs

       ; implicit_kvs <-
           case Maybe (a, [Name])
mb_assoc of
             Maybe (a, [Name])
Nothing -> FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM FreeKiTyVars
all_implicit_kvs
             Just (a
_, [Name]
cls_tvs) -> [Name] -> FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeNonClassM [Name]
cls_tvs FreeKiTyVars
all_implicit_kvs
                 -- See Note [Class variables and filterInScope]

       ; traceRn "checkMixedVars3" $
           vcat [ text "bndrs"   <+> ppr hs_tv_bndrs
                , text "bndr_kv_occs"   <+> ppr bndr_kv_occs
                , text "body_kv_occs"   <+> ppr body_kv_occs
                , text "implicit_kvs"   <+> ppr implicit_kvs
                , text "body_remaining" <+> ppr body_remaining
                ]

       ; rnImplicitTvOccs mb_assoc implicit_kvs $ \ [Name]
implicit_kv_nms' ->
         HsDocContext
-> WarnUnusedForalls
-> Maybe (a, [Name])
-> [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
-> ([LHsTyVarBndr (HsBndrVis GhcPs) GhcRn] -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
NoWarnUnusedForalls Maybe (a, [Name])
mb_assoc [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
hs_tv_bndrs (([LHsTyVarBndr (HsBndrVis GhcPs) GhcRn] -> RnM (b, FreeNames))
 -> RnM (b, FreeNames))
-> ([LHsTyVarBndr (HsBndrVis GhcPs) GhcRn] -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
forall a b. (a -> b) -> a -> b
$ \ [LHsTyVarBndr (HsBndrVis GhcPs) GhcRn]
rn_bndrs ->
           -- This is the only call site for bindLHsTyVarBndrs where we pass
           -- NoWarnUnusedForalls, which suppresses -Wunused-foralls warnings.
           -- See Note [Suppress -Wunused-foralls when binding LHsQTyVars].
    do { rn_bndrs <- (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcRn)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcRn)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse LHsTyVarBndr (HsBndrVis GhcPs) GhcRn
-> RnM (LHsTyVarBndr (HsBndrVis GhcRn) GhcRn)
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcRn)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn))
rnLHsTyVarBndrVisFlag [LHsTyVarBndr (HsBndrVis GhcPs) GhcRn]
[GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcRn)]
rn_bndrs
       ; let -- The SrcSpan that rnImplicitTvOccs will attach to each Name will
             -- span the entire declaration to which the LHsQTyVars belongs,
             -- which will be reflected in warning and error messages. We can
             -- be a little more precise than that by pointing to the location
             -- of the LHsQTyVars instead, which is what bndrs_loc
             -- corresponds to.
             implicit_kv_nms = (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> SrcSpan -> Name
`setNameLoc` SrcSpan
bndrs_loc) [Name]
implicit_kv_nms'

       ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs)
       ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms
                              , hsq_explicit  = rn_bndrs })
                      body_remaining } }
  where
    hs_tv_bndrs :: [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
hs_tv_bndrs = LHsQTyVars GhcPs -> [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
forall (p :: Pass).
LHsQTyVars (GhcPass p)
-> [LHsTyVarBndr (HsBndrVis (GhcPass p)) (GhcPass p)]
hsQTvExplicit LHsQTyVars GhcPs
hsq_bndrs

    -- The SrcSpan of the LHsQTyVars. For example, bndrs_loc would be the
    -- highlighted part in the class below:
    --
    --   class C (a :: j) (b :: k) where
    --            ^^^^^^^^^^^^^^^
    bndrs_loc :: SrcSpan
bndrs_loc = case (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
 -> SrcSpan)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr (HsBndrVis GhcPs) GhcPs -> SrcSpan
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> SrcSpan
forall flag. LHsTyVarBndr flag GhcPs -> SrcSpan
get_bndr_loc [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
hs_tv_bndrs [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ (GenLocated SrcSpanAnnN RdrName -> SrcSpan)
-> FreeKiTyVars -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA FreeKiTyVars
body_kv_occs of
      []         -> String -> SrcSpan
forall a. HasCallStack => String -> a
panic String
"bindHsQTyVars.bndrs_loc"
      [SrcSpan
loc]      -> SrcSpan
loc
      (SrcSpan
loc:[SrcSpan]
locs) -> SrcSpan
loc SrcSpan -> SrcSpan -> SrcSpan
`combineSrcSpans` [SrcSpan] -> SrcSpan
forall a. HasCallStack => [a] -> a
last [SrcSpan]
locs

    -- The in-tree API annotations extend the LHsTyVarBndr location to
    -- include surrounding parens. for error messages to be
    -- compatible, we recreate the location from the contents
    get_bndr_loc :: LHsTyVarBndr flag GhcPs -> SrcSpan
    get_bndr_loc :: forall flag. LHsTyVarBndr flag GhcPs -> SrcSpan
get_bndr_loc (L SrcSpanAnnA
l HsTyVarBndr flag GhcPs
tvb) =
      SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans
        (case HsTyVarBndr flag GhcPs -> HsBndrVar GhcPs
forall flag (pass :: Pass).
HsTyVarBndr flag (GhcPass pass) -> HsBndrVar (GhcPass pass)
hsBndrVar HsTyVarBndr flag GhcPs
tvb of
          HsBndrWildCard XBndrWildCard GhcPs
tok ->
            case XBndrWildCard GhcPs
tok of
              EpToken "_"
XBndrWildCard GhcPs
NoEpTok   -> SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l
              EpTok EpaLocation
loc -> EpaLocation -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpaLocation
loc
          HsBndrVar XBndrVar GhcPs
_ LIdP GhcPs
ln   -> GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
ln)
        (case HsTyVarBndr flag GhcPs -> HsBndrKind GhcPs
forall flag (pass :: Pass).
HsTyVarBndr flag (GhcPass pass) -> HsBndrKind (GhcPass pass)
hsBndrKind HsTyVarBndr flag GhcPs
tvb of
          HsBndrNoKind XBndrNoKind GhcPs
_ -> SrcSpan
noSrcSpan
          HsBndrKind XBndrKind GhcPs
_ LHsType GhcPs
lk -> GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lk)

{- Note [bindHsQTyVars examples]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have
   data T k (a::k1) (b::k) :: k2 -> k1 -> *

Then:
  hs_tv_bndrs = [k, a::k1, b::k], the explicitly-bound variables
  bndrs       = [k,a,b]

  bndr_kv_occs = [k,k1], kind variables free in kind signatures
                         of hs_tv_bndrs

  body_kv_occs = [k2,k1], kind variables free in the
                          result kind signature

  implicit_kvs = [k1,k2,k1], kind variables free in kind signatures
                             of hs_tv_bndrs, and not bound by bndrs

* We want to quantify add implicit bindings for implicit_kvs

* If body_kv_occs is non-empty, then there is a kind variable
  mentioned in the kind signature that is not bound "on the left".
  That's one of the rules for a CUSK, so we pass that info on
  as the second argument to thing_inside.

* Order is important in these lists. Consider
    data T (a::k1) (b::k2)
  We want implicit_kvs to be [k1,k2], not [k2,k1], so that the inferred kind for
  T quantifies over kind variables in the user-specified order
    T :: forall k1 k2. k1 -> k2 -> Type  -- OK
    T :: forall k2 k1. k1 -> k2 -> Type  -- Bad
  This matters with TypeApplications

* bndr_kv_occs, body_kv_occs, and implicit_kvs can contain duplicates. All
  duplicate occurrences are removed when we bind them with rnImplicitTvOccs.

Finally, you may wonder why filterFreeNamesToBind removes in-scope variables
from bndr/body_kv_occs.  How can anything be in scope?  Answer:
HsQTyVars is /also/ used (slightly oddly) for Haskell-98 syntax
ConDecls
   data T a = forall (b::k). MkT a b
The ConDecl has a LHsQTyVars in it; but 'a' scopes over the entire
ConDecl.  Hence the local RdrEnv may be non-empty and we must filter
out 'a' from the free vars.  (Mind you, in this situation all the
implicit kind variables are bound at the data type level, so there
are none to bind in the ConDecl, so there are no implicitly bound
variables at all.

Note [Kind variable scoping]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have
  data T (a :: k) k = ...
we report "k is out of scope" for (a::k).  Reason: k is not brought
into scope until the explicit k-binding that follows.  It would be
terribly confusing to bring into scope an /implicit/ k for a's kind
and a distinct, shadowing explicit k that follows, something like
  data T {k1} (a :: k1) k = ...

So the rule is:

   the implicit binders never include any
   of the explicit binders in the group

Note that in the denerate case
  data T (a :: a) = blah
we get a complaint the second 'a' is not in scope.

That applies to foralls too: e.g.
   forall (a :: k) k . blah

But if the foralls are split, we treat the two groups separately:
   forall (a :: k). forall k. blah
Here we bring into scope an implicit k, which is later shadowed
by the explicit k.

In implementation terms

* In bindHsQTyVars 'k' is free in bndr_kv_occs; then we delete
  the binders {a,k}, and so end with no implicit binders.  Then we
  rename the binders left-to-right, and hence see that 'k' is out of
  scope in the kind of 'a'.

* Similarly in extract_hs_tv_bndrs

Note [Variables used as both types and kinds]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We bind the type variables tvs, and kvs is the set of free variables of the
kinds in the scope of the binding. Here is one typical example:

   forall a b. a -> (b::k) -> (c::a)

Here, tvs will be {a,b}, and kvs {k,a}.

We must make sure that kvs includes all of variables in the kinds of type
variable bindings. For instance:

   forall k (a :: k). Proxy a

If we only look in the body of the `forall` type, we will mistakenly conclude
that kvs is {}. But in fact, the type variable `k` is also used as a kind
variable in (a :: k), later in the binding. (This mistake lead to #14710.)
So tvs is {k,a} and kvs is {k}.

NB: we do this only at the binding site of 'tvs'.

Note [Suppress -Wunused-foralls when binding LHsQTyVars]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The WarnUnusedForalls flag controls whether bindLHsTyVarBndrs should warn about
explicit type variable binders that go unused (e.g., the `a` in
`forall a. Int`). We almost always want to warn about these, since unused type
variables can usually be deleted without any repercussions. There is one
exception to this rule, however: binding LHsQTyVars. Consider this example:

  data Proxy a = Proxy

The `a` in `Proxy a` is bound by an LHsQTyVars, and the code which brings it
into scope, bindHsQTyVars, will invoke bindLHsTyVarBndrs in turn. As such, it
has a choice to make about whether to emit -Wunused-foralls warnings or not.
If it /did/ emit warnings, then the `a` would be flagged as unused. However,
this is not what we want! Removing the `a` in `Proxy a` would change its kind
entirely, which is a huge price to pay for fixing a warning.

Unlike other forms of type variable binders, dropping "unused" variables in
an LHsQTyVars can be semantically significant. As a result, we suppress
-Wunused-foralls warnings in exactly one place: in bindHsQTyVars.
-}

bindHsOuterTyVarBndrs :: OutputableBndrFlag flag 'Renamed
                      => HsDocContext
                      -> Maybe assoc
                         -- ^ @'Just' _@ => an associated type decl
                      -> FreeKiTyVars
                      -> HsOuterTyVarBndrs flag GhcPs
                      -> (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeNames))
                      -> RnM (a, FreeNames)
bindHsOuterTyVarBndrs :: forall flag assoc a.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> Maybe assoc
-> FreeKiTyVars
-> HsOuterTyVarBndrs flag GhcPs
-> (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
bindHsOuterTyVarBndrs HsDocContext
doc Maybe assoc
mb_cls FreeKiTyVars
implicit_vars HsOuterTyVarBndrs flag GhcPs
outer_bndrs HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeNames)
thing_inside =
  case HsOuterTyVarBndrs flag GhcPs
outer_bndrs of
    HsOuterImplicit{} ->
      Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall assoc a.
Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
rnImplicitTvOccs Maybe assoc
mb_cls FreeKiTyVars
implicit_vars (([Name] -> RnM (a, FreeNames)) -> RnM (a, FreeNames))
-> ([Name] -> RnM (a, FreeNames)) -> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ \[Name]
implicit_vars' ->
        HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeNames)
thing_inside (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeNames))
-> HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ HsOuterImplicit { hso_ximplicit :: XHsOuterImplicit GhcRn
hso_ximplicit = [Name]
XHsOuterImplicit GhcRn
implicit_vars' }
    HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr flag (NoGhcTc GhcPs)]
exp_bndrs} ->
      -- Note: If we pass mb_cls instead of Nothing below, bindLHsTyVarBndrs
      -- will use class variables for any names the user meant to bring in
      -- scope here. This is an explicit forall, so we want fresh names, not
      -- class variables. Thus: always pass Nothing.
      HsDocContext
-> WarnUnusedForalls
-> Maybe a_2
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
WarnUnusedForalls Maybe a_2
forall a. Maybe a
Nothing [LHsTyVarBndr flag (NoGhcTc GhcPs)]
[LHsTyVarBndr flag GhcPs]
exp_bndrs (([LHsTyVarBndr flag GhcRn] -> RnM (a, FreeNames))
 -> RnM (a, FreeNames))
-> ([LHsTyVarBndr flag GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ \[LHsTyVarBndr flag GhcRn]
exp_bndrs' -> do
        HsDocContext -> [LHsTyVarBndr flag GhcRn] -> TcRn ()
forall flag (p :: Pass).
HsDocContext -> [LHsTyVarBndr flag (GhcPass p)] -> TcRn ()
checkForAllTelescopeWildcardBndrs HsDocContext
doc [LHsTyVarBndr flag GhcRn]
exp_bndrs'
        HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeNames)
thing_inside (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeNames))
-> HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ HsOuterExplicit { hso_xexplicit :: XHsOuterExplicit GhcRn flag
hso_xexplicit = XHsOuterExplicit GhcRn flag
NoExtField
noExtField
                                       , hso_bndrs :: [LHsTyVarBndr flag (NoGhcTc GhcRn)]
hso_bndrs     = [LHsTyVarBndr flag (NoGhcTc GhcRn)]
[LHsTyVarBndr flag GhcRn]
exp_bndrs' }

-- See Note [Term variable capture and implicit quantification]
warn_term_var_capture :: LocatedN RdrName -> RnM ()
warn_term_var_capture :: GenLocated SrcSpanAnnN RdrName -> TcRn ()
warn_term_var_capture GenLocated SrcSpanAnnN RdrName
lVar = do
    gbl_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
    local_env <- getLocalRdrEnv
    case demoteRdrNameTv $ unLoc lVar of
      Maybe RdrName
Nothing           -> () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just RdrName
demoted_name -> do
        let global_vars :: [GlobalRdrElt]
global_vars = GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
gbl_env (RdrName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName RdrName
demoted_name WhichGREs GREInfo
forall info. WhichGREs info
SameNameSpace)
        let mlocal_var :: Maybe Name
mlocal_var  = LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv LocalRdrEnv
local_env RdrName
demoted_name
        case Maybe Name
mlocal_var of
          Just Name
name -> GenLocated SrcSpanAnnN RdrName
-> Either [GlobalRdrElt] Name -> TcRn ()
warnCapturedTerm GenLocated SrcSpanAnnN RdrName
lVar (Name -> Either [GlobalRdrElt] Name
forall a b. b -> Either a b
Right Name
name)
          Maybe Name
Nothing   -> Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
global_vars) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
                         GenLocated SrcSpanAnnN RdrName
-> Either [GlobalRdrElt] Name -> TcRn ()
warnCapturedTerm GenLocated SrcSpanAnnN RdrName
lVar ([GlobalRdrElt] -> Either [GlobalRdrElt] Name
forall a b. a -> Either a b
Left [GlobalRdrElt]
global_vars)

bindHsForAllTelescope :: HsDocContext
                      -> HsForAllTelescope GhcPs
                      -> (HsForAllTelescope GhcRn -> RnM (a, FreeNames))
                      -> RnM (a, FreeNames)
bindHsForAllTelescope :: forall a.
HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
bindHsForAllTelescope HsDocContext
doc HsForAllTelescope GhcPs
tele HsForAllTelescope GhcRn -> RnM (a, FreeNames)
thing_inside =
  case HsForAllTelescope GhcPs
tele of
    HsForAllVis { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () GhcPs]
bndrs } ->
      HsDocContext
-> WarnUnusedForalls
-> Maybe a_0
-> [LHsTyVarBndr () GhcPs]
-> ([LHsTyVarBndr () GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
WarnUnusedForalls Maybe a_0
forall a. Maybe a
Nothing [LHsTyVarBndr () GhcPs]
bndrs (([LHsTyVarBndr () GhcRn] -> RnM (a, FreeNames))
 -> RnM (a, FreeNames))
-> ([LHsTyVarBndr () GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ \[LHsTyVarBndr () GhcRn]
bndrs' -> do
        HsDocContext -> [LHsTyVarBndr () GhcRn] -> TcRn ()
forall flag (p :: Pass).
HsDocContext -> [LHsTyVarBndr flag (GhcPass p)] -> TcRn ()
checkForAllTelescopeWildcardBndrs HsDocContext
doc [LHsTyVarBndr () GhcRn]
bndrs'
        HsForAllTelescope GhcRn -> RnM (a, FreeNames)
thing_inside (HsForAllTelescope GhcRn -> RnM (a, FreeNames))
-> HsForAllTelescope GhcRn -> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ EpAnnForallVis
-> [LHsTyVarBndr () GhcRn] -> HsForAllTelescope GhcRn
forall (p :: Pass).
EpAnnForallVis
-> [LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
mkHsForAllVisTele EpAnnForallVis
forall a. NoAnn a => a
noAnn [LHsTyVarBndr () GhcRn]
bndrs'
    HsForAllInvis { hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity GhcPs]
bndrs } ->
      HsDocContext
-> WarnUnusedForalls
-> Maybe a_1
-> [LHsTyVarBndr Specificity GhcPs]
-> ([LHsTyVarBndr Specificity GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
WarnUnusedForalls Maybe a_1
forall a. Maybe a
Nothing [LHsTyVarBndr Specificity GhcPs]
bndrs (([LHsTyVarBndr Specificity GhcRn] -> RnM (a, FreeNames))
 -> RnM (a, FreeNames))
-> ([LHsTyVarBndr Specificity GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ \[LHsTyVarBndr Specificity GhcRn]
bndrs' -> do
        HsDocContext -> [LHsTyVarBndr Specificity GhcRn] -> TcRn ()
forall flag (p :: Pass).
HsDocContext -> [LHsTyVarBndr flag (GhcPass p)] -> TcRn ()
checkForAllTelescopeWildcardBndrs HsDocContext
doc [LHsTyVarBndr Specificity GhcRn]
bndrs'
        HsForAllTelescope GhcRn -> RnM (a, FreeNames)
thing_inside (HsForAllTelescope GhcRn -> RnM (a, FreeNames))
-> HsForAllTelescope GhcRn -> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ EpAnnForallInvis
-> [LHsTyVarBndr Specificity GhcRn] -> HsForAllTelescope GhcRn
forall (p :: Pass).
EpAnnForallInvis
-> [LHsTyVarBndr Specificity (GhcPass p)]
-> HsForAllTelescope (GhcPass p)
mkHsForAllInvisTele EpAnnForallInvis
forall a. NoAnn a => a
noAnn [LHsTyVarBndr Specificity GhcRn]
bndrs'

bindHsForAllTelescopes :: HsDocContext
                       -> [HsForAllTelescope GhcPs]
                       -> ([HsForAllTelescope GhcRn] -> RnM (a, FreeNames))
                       -> RnM (a, FreeNames)
bindHsForAllTelescopes :: forall a.
HsDocContext
-> [HsForAllTelescope GhcPs]
-> ([HsForAllTelescope GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
bindHsForAllTelescopes HsDocContext
_ [] [HsForAllTelescope GhcRn] -> RnM (a, FreeNames)
thing_inside =
  [HsForAllTelescope GhcRn] -> RnM (a, FreeNames)
thing_inside []
bindHsForAllTelescopes HsDocContext
doc (HsForAllTelescope GhcPs
tele:[HsForAllTelescope GhcPs]
teles) [HsForAllTelescope GhcRn] -> RnM (a, FreeNames)
thing_inside =
  HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall a.
HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
bindHsForAllTelescope  HsDocContext
doc HsForAllTelescope GhcPs
tele  ((HsForAllTelescope GhcRn -> RnM (a, FreeNames))
 -> RnM (a, FreeNames))
-> (HsForAllTelescope GhcRn -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ \HsForAllTelescope GhcRn
tele'  ->
  HsDocContext
-> [HsForAllTelescope GhcPs]
-> ([HsForAllTelescope GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall a.
HsDocContext
-> [HsForAllTelescope GhcPs]
-> ([HsForAllTelescope GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
bindHsForAllTelescopes HsDocContext
doc [HsForAllTelescope GhcPs]
teles (([HsForAllTelescope GhcRn] -> RnM (a, FreeNames))
 -> RnM (a, FreeNames))
-> ([HsForAllTelescope GhcRn] -> RnM (a, FreeNames))
-> RnM (a, FreeNames)
forall a b. (a -> b) -> a -> b
$ \[HsForAllTelescope GhcRn]
teles' ->
    [HsForAllTelescope GhcRn] -> RnM (a, FreeNames)
thing_inside (HsForAllTelescope GhcRn
tele'HsForAllTelescope GhcRn
-> [HsForAllTelescope GhcRn] -> [HsForAllTelescope GhcRn]
forall a. a -> [a] -> [a]
:[HsForAllTelescope GhcRn]
teles')

-- See Note [Wildcard binders in disallowed contexts] in GHC.Hs.Type
checkForAllTelescopeWildcardBndrs :: HsDocContext
                                  -> [LHsTyVarBndr flag (GhcPass p)]
                                  -> RnM ()
checkForAllTelescopeWildcardBndrs :: forall flag (p :: Pass).
HsDocContext -> [LHsTyVarBndr flag (GhcPass p)] -> TcRn ()
checkForAllTelescopeWildcardBndrs HsDocContext
doc [LHsTyVarBndr flag (GhcPass p)]
tvbs = (SrcSpan -> TcRn ()) -> [SrcSpan] -> TcRn ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SrcSpan -> TcRn ()
report_err [SrcSpan]
wc_bndr_locs
  where
    report_err :: SrcSpan -> RnM ()
    report_err :: SrcSpan -> TcRn ()
report_err SrcSpan
loc =
      SrcSpan -> TcRnMessage -> TcRn ()
addErrAt SrcSpan
loc (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ HsDocContext -> TcRnMessage -> TcRnMessage
TcRnWithHsDocContext HsDocContext
doc (TcRnMessage -> TcRnMessage) -> TcRnMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
        Maybe Name -> BadAnonWildcardContext -> TcRnMessage
TcRnIllegalWildcardInType Maybe Name
forall a. Maybe a
Nothing BadAnonWildcardContext
WildcardBndrInForallTelescope

    wc_bndr_locs :: [SrcSpan]
    wc_bndr_locs :: [SrcSpan]
wc_bndr_locs = [SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
l | L SrcSpanAnnA
l (HsTvb XTyVarBndr (GhcPass p)
_ flag
_ HsBndrWildCard{} HsBndrKind (GhcPass p)
_) <- [LHsTyVarBndr flag (GhcPass p)]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag (GhcPass p))]
tvbs ]

-- | Should GHC warn if a quantified type variable goes unused? Usually, the
-- answer is \"yes\", but in the particular case of binding 'LHsQTyVars', we
-- avoid emitting warnings.
-- See @Note [Suppress -Wunused-foralls when binding LHsQTyVars]@.
data WarnUnusedForalls
  = WarnUnusedForalls
  | NoWarnUnusedForalls

instance Outputable WarnUnusedForalls where
  ppr :: WarnUnusedForalls -> SDoc
ppr WarnUnusedForalls
wuf = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ case WarnUnusedForalls
wuf of
    WarnUnusedForalls
WarnUnusedForalls   -> String
"WarnUnusedForalls"
    WarnUnusedForalls
NoWarnUnusedForalls -> String
"NoWarnUnusedForalls"

bindLHsTyVarBndrs :: (OutputableBndrFlag flag 'Renamed)
                  => HsDocContext
                  -> WarnUnusedForalls
                  -> Maybe a               -- Just _  => an associated type decl
                  -> [LHsTyVarBndr flag GhcPs]  -- User-written tyvars
                  -> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeNames))
                  -> RnM (b, FreeNames)
bindLHsTyVarBndrs :: forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
wuf Maybe a
mb_assoc [LHsTyVarBndr flag GhcPs]
tv_bndrs [LHsTyVarBndr flag GhcRn] -> RnM (b, FreeNames)
thing_inside
  = do { Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
mb_assoc) (FreeKiTyVars -> TcRn ()
checkShadowedRdrNames FreeKiTyVars
tv_names_w_loc)
       ; FreeKiTyVars -> TcRn ()
checkDupRdrNames FreeKiTyVars
tv_names_w_loc
       ; [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
    -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
go [LHsTyVarBndr flag GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
tv_bndrs [LHsTyVarBndr flag GhcRn] -> RnM (b, FreeNames)
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeNames)
thing_inside }
  where
    tv_names_w_loc :: FreeKiTyVars
tv_names_w_loc = (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
 -> Maybe (GenLocated SrcSpanAnnN RdrName))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
-> FreeKiTyVars
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LHsTyVarBndr flag GhcPs -> Maybe (LocatedN (IdP GhcPs))
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> Maybe (GenLocated SrcSpanAnnN RdrName)
forall (p :: Pass) flag.
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsTyVarBndr flag (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
hsLTyVarLocName [LHsTyVarBndr flag GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
tv_bndrs

    go :: [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
    -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
go []     [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeNames)
thing_inside = [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeNames)
thing_inside []
    go (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
b:[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
bs) [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeNames)
thing_inside = HsDocContext
-> Maybe a
-> LHsTyVarBndr flag GhcPs
-> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
forall a flag b.
HsDocContext
-> Maybe a
-> LHsTyVarBndr flag GhcPs
-> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
bindLHsTyVarBndr HsDocContext
doc Maybe a
mb_assoc LHsTyVarBndr flag GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
b ((LHsTyVarBndr flag GhcRn -> RnM (b, FreeNames))
 -> RnM (b, FreeNames))
-> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
forall a b. (a -> b) -> a -> b
$ \ LHsTyVarBndr flag GhcRn
b' ->
                             do { (res, fvs) <- [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
    -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
go [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
bs (([GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
  -> RnM (b, FreeNames))
 -> RnM (b, FreeNames))
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
    -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
forall a b. (a -> b) -> a -> b
$ \ [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
bs' ->
                                                [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeNames)
thing_inside (LHsTyVarBndr flag GhcRn
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
b' GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
bs')
                                ; warn_unused b' fvs
                                ; return (res, fvs) }

    warn_unused :: GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
-> FreeNames -> TcRn ()
warn_unused GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
tv_bndr FreeNames
fvs = case WarnUnusedForalls
wuf of
      WarnUnusedForalls
WarnUnusedForalls   -> HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeNames -> TcRn ()
forall flag.
OutputableBndrFlag flag 'Renamed =>
HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeNames -> TcRn ()
warnUnusedForAll HsDocContext
doc LHsTyVarBndr flag GhcRn
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
tv_bndr FreeNames
fvs
      WarnUnusedForalls
NoWarnUnusedForalls -> () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

bindLHsTyVarBndr :: HsDocContext
                 -> Maybe a   -- associated class
                 -> LHsTyVarBndr flag GhcPs
                 -> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeNames))
                 -> RnM (b, FreeNames)
bindLHsTyVarBndr :: forall a flag b.
HsDocContext
-> Maybe a
-> LHsTyVarBndr flag GhcPs
-> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
bindLHsTyVarBndr HsDocContext
doc Maybe a
mb_assoc (L SrcSpanAnnA
loc (HsTvb XTyVarBndr GhcPs
x flag
fl HsBndrVar GhcPs
bvar HsBndrKind GhcPs
kind)) LHsTyVarBndr flag GhcRn -> RnM (b, FreeNames)
thing_inside
  = do { (kind', fvs1) <- HsDocContext
-> HsBndrKind GhcPs -> RnM (HsBndrKind GhcRn, FreeNames)
rnHsBndrKind HsDocContext
doc HsBndrKind GhcPs
kind
       ; (b, fvs2) <- bindHsBndrVar mb_assoc bvar $ \HsBndrVar GhcRn
bvar' ->
            LHsTyVarBndr flag GhcRn -> RnM (b, FreeNames)
thing_inside (SrcSpanAnnA
-> HsTyVarBndr flag GhcRn
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XTyVarBndr GhcRn
-> flag
-> HsBndrVar GhcRn
-> HsBndrKind GhcRn
-> HsTyVarBndr flag GhcRn
forall flag pass.
XTyVarBndr pass
-> flag
-> HsBndrVar pass
-> HsBndrKind pass
-> HsTyVarBndr flag pass
HsTvb XTyVarBndr GhcPs
XTyVarBndr GhcRn
x flag
fl HsBndrVar GhcRn
bvar' HsBndrKind GhcRn
kind'))
       ; return (b, fvs1 `plusFN` fvs2) }

bindHsBndrVar :: Maybe a   -- associated class
              -> HsBndrVar GhcPs
              -> (HsBndrVar GhcRn -> RnM (b, FreeNames))
              -> RnM (b, FreeNames)
bindHsBndrVar :: forall a b.
Maybe a
-> HsBndrVar GhcPs
-> (HsBndrVar GhcRn -> RnM (b, FreeNames))
-> RnM (b, FreeNames)
bindHsBndrVar Maybe a
mb_assoc (HsBndrVar XBndrVar GhcPs
_ lrdr :: LIdP GhcPs
lrdr@(L SrcSpanAnnN
lv RdrName
_)) HsBndrVar GhcRn -> RnM (b, FreeNames)
thing_inside
  = do { tv_nm  <- Maybe a
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a.
Maybe a
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn Maybe a
mb_assoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
lrdr
       ; bindLocalNamesFV [tv_nm] $
         thing_inside (HsBndrVar noExtField (L lv tv_nm)) }
bindHsBndrVar Maybe a
_ (HsBndrWildCard XBndrWildCard GhcPs
_) HsBndrVar GhcRn -> RnM (b, FreeNames)
thing_inside
  = HsBndrVar GhcRn -> RnM (b, FreeNames)
thing_inside (XBndrWildCard GhcRn -> HsBndrVar GhcRn
forall pass. XBndrWildCard pass -> HsBndrVar pass
HsBndrWildCard NoExtField
XBndrWildCard GhcRn
noExtField)

rnHsBndrKind :: HsDocContext -> HsBndrKind GhcPs -> RnM (HsBndrKind GhcRn, FreeNames)
rnHsBndrKind :: HsDocContext
-> HsBndrKind GhcPs -> RnM (HsBndrKind GhcRn, FreeNames)
rnHsBndrKind HsDocContext
_ (HsBndrNoKind XBndrNoKind GhcPs
_) = (HsBndrKind GhcRn, FreeNames) -> RnM (HsBndrKind GhcRn, FreeNames)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XBndrNoKind GhcRn -> HsBndrKind GhcRn
forall pass. XBndrNoKind pass -> HsBndrKind pass
HsBndrNoKind NoExtField
XBndrNoKind GhcRn
noExtField, FreeNames
emptyFNs)
rnHsBndrKind HsDocContext
doc (HsBndrKind XBndrKind GhcPs
_ LHsType GhcPs
kind) =
  do { sig_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.KindSignatures
     ; unless sig_ok (badKindSigErr doc kind)
     ; (kind', fvs) <- rnLHsKind doc kind
     ; return (HsBndrKind noExtField kind', fvs) }

-- Check for TypeAbstractions and update the type parameter of HsBndrVis.
-- The binder itself is already renamed and is returned unmodified.
rnLHsTyVarBndrVisFlag
  :: LHsTyVarBndr (HsBndrVis GhcPs) GhcRn
  -> RnM (LHsTyVarBndr (HsBndrVis GhcRn) GhcRn)
rnLHsTyVarBndrVisFlag :: LHsTyVarBndr (HsBndrVis GhcPs) GhcRn
-> RnM (LHsTyVarBndr (HsBndrVis GhcRn) GhcRn)
rnLHsTyVarBndrVisFlag (L SrcSpanAnnA
loc HsTyVarBndr (HsBndrVis GhcPs) GhcRn
bndr) = do
  let lbndr :: GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
lbndr = SrcSpanAnnA
-> HsTyVarBndr (HsBndrVis GhcRn) GhcRn
-> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc ((HsBndrVis GhcPs -> HsBndrVis GhcRn)
-> HsTyVarBndr (HsBndrVis GhcPs) GhcRn
-> HsTyVarBndr (HsBndrVis GhcRn) GhcRn
forall flag flag' (pass :: Pass).
(flag -> flag')
-> HsTyVarBndr flag (GhcPass pass)
-> HsTyVarBndr flag' (GhcPass pass)
updateHsTyVarBndrFlag HsBndrVis GhcPs -> HsBndrVis GhcRn
rnHsBndrVis HsTyVarBndr (HsBndrVis GhcPs) GhcRn
bndr)
  Extension -> TcRn () -> TcRn ()
forall gbl lcl. Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
unlessXOptM Extension
LangExt.TypeAbstractions (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HsBndrVis GhcPs -> Bool
forall pass. HsBndrVis pass -> Bool
isHsBndrInvisible (HsTyVarBndr (HsBndrVis GhcPs) GhcRn -> HsBndrVis GhcPs
forall flag (pass :: Pass). HsTyVarBndr flag (GhcPass pass) -> flag
hsTyVarBndrFlag HsTyVarBndr (HsBndrVis GhcPs) GhcRn
bndr)) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
      TcRnMessage -> TcRn ()
addErr (LHsTyVarBndr (HsBndrVis GhcRn) GhcRn -> TcRnMessage
TcRnIllegalInvisTyVarBndr LHsTyVarBndr (HsBndrVis GhcRn) GhcRn
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
lbndr)
    Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HsBndrVar GhcRn -> Bool
forall pass. HsBndrVar pass -> Bool
isHsBndrWildCard (HsTyVarBndr (HsBndrVis GhcPs) GhcRn -> HsBndrVar GhcRn
forall flag (pass :: Pass).
HsTyVarBndr flag (GhcPass pass) -> HsBndrVar (GhcPass pass)
hsBndrVar HsTyVarBndr (HsBndrVis GhcPs) GhcRn
bndr)) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
      TcRnMessage -> TcRn ()
addErr (LHsTyVarBndr (HsBndrVis GhcRn) GhcRn -> TcRnMessage
TcRnIllegalWildcardTyVarBndr LHsTyVarBndr (HsBndrVis GhcRn) GhcRn
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
lbndr)
  GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
lbndr

-- rnHsBndrVis is almost a no-op, it simply discards the token for "@".
rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn
rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn
rnHsBndrVis (HsBndrRequired XBndrRequired GhcPs
_)    = XBndrRequired GhcRn -> HsBndrVis GhcRn
forall pass. XBndrRequired pass -> HsBndrVis pass
HsBndrRequired  NoExtField
XBndrRequired GhcRn
noExtField
rnHsBndrVis (HsBndrInvisible XBndrInvisible GhcPs
_at) = XBndrInvisible GhcRn -> HsBndrVis GhcRn
forall pass. XBndrInvisible pass -> HsBndrVis pass
HsBndrInvisible NoExtField
XBndrInvisible GhcRn
noExtField

newTyVarNameRn, newTyVarNameRnImplicit
  :: Maybe a -- associated class
  -> LocatedN RdrName -> RnM Name
newTyVarNameRn :: forall a.
Maybe a
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn         Maybe a
mb_assoc = Maybe a
-> (GenLocated SrcSpanAnnN RdrName
    -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a.
Maybe a
-> (GenLocated SrcSpanAnnN RdrName
    -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
new_tv_name_rn Maybe a
mb_assoc GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newLocalBndrRn
newTyVarNameRnImplicit :: forall a.
Maybe a
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRnImplicit Maybe a
mb_assoc = Maybe a
-> (GenLocated SrcSpanAnnN RdrName
    -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a.
Maybe a
-> (GenLocated SrcSpanAnnN RdrName
    -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
new_tv_name_rn Maybe a
mb_assoc ((GenLocated SrcSpanAnnN RdrName
  -> IOEnv (Env TcGblEnv TcLclEnv) Name)
 -> GenLocated SrcSpanAnnN RdrName
 -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> (GenLocated SrcSpanAnnN RdrName
    -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnN RdrName
lrdr ->
  do { GenLocated SrcSpanAnnN RdrName -> TcRn ()
warn_term_var_capture GenLocated SrcSpanAnnN RdrName
lrdr
     ; GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newLocalBndrRn GenLocated SrcSpanAnnN RdrName
lrdr }

new_tv_name_rn :: Maybe a -- associated class
               -> (LocatedN RdrName -> RnM Name) -- how to create a new name
               -> (LocatedN RdrName -> RnM Name)
new_tv_name_rn :: forall a.
Maybe a
-> (GenLocated SrcSpanAnnN RdrName
    -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
new_tv_name_rn Maybe a
Nothing  GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
cont GenLocated SrcSpanAnnN RdrName
lrdr = GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
cont GenLocated SrcSpanAnnN RdrName
lrdr
new_tv_name_rn (Just a
_) GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
cont lrdr :: GenLocated SrcSpanAnnN RdrName
lrdr@(L SrcSpanAnnN
_ RdrName
rdr)
  = do { rdr_env <- RnM LocalRdrEnv
getLocalRdrEnv
       ; case lookupLocalRdrEnv rdr_env rdr of
           Just Name
n -> Name -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n -- Use the same Name as the parent class decl
           Maybe Name
_      -> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
cont GenLocated SrcSpanAnnN RdrName
lrdr }

{- Note [Term variable capture and implicit quantification]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Wterm-variable-capture is a warning introduced in GHC Proposal #281 "Visible forall in types of terms",
Section 7.3: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst#73implicit-quantification

Its purpose is to notify users when implicit quantification occurs that would
stop working under RequiredTypeArguments. Example:

   a = 42
   id :: a -> a

As it stands, the `a` in the signature `id :: a -> a` is considered free and
leads to implicit quantification, as if the user wrote `id :: forall a. a -> a`.
Under RequiredTypeArguments it captures the term-level variable `a` (bound by `a = 42`),
leading to a type error.

`warn_term_var_capture` detects this by demoting the namespace of the
implicitly quantified type variable (`TvName` becomes `VarName`) and looking it up
in the environment. But when do we call `warn_term_var_capture`? It's tempting
to do so at the start of `rnImplicitTvOccs`, as soon as we know our implicit
variables:

  rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside
    = do { let implicit_vs = nubN implicit_vs_with_dups
         ; mapM_ warn_term_var_capture implicit_vs
         ... }

This approach generates false positives (#23434) because it misses a corner
case: class variables in associated types. Consider the following example:

  k = 12
  class C k a where
    type AT a :: k -> Type

If we look at the signature for `AT` in isolation, the `k` looks like a free
variable, so it's passed to `rnImplicitTvOccs`. And if we passed it to
`warn_term_var_capture`, we would find the `k` bound by `k = 12` and report a warning.
But we don't want that: `k` is actually bound in the declaration header of the
parent class.

The solution is to check if it's a class variable (this is done in `new_tv_name_rn`)
before we check for term variable capture.
-}

{-
*********************************************************
*                                                       *
        HsConDeclRecField
*                                                       *
*********************************************************

When renaming a HsConDeclRecField, we have to find the FieldLabel
associated with each field.  But we already have all the FieldLabels
available (since they were brought into scope by
GHC.Rename.Names.getLocalNonValBinders), so we just take the list as an
argument, build a map and look them up.
-}

rnHsConDeclRecFields :: HsDocContext -> [FieldLabel] -> [LHsConDeclRecField GhcPs]
                -> RnM ([LHsConDeclRecField GhcRn], FreeNames)
-- Also called from GHC.Rename.Module
-- No wildcards can appear in record fields
rnHsConDeclRecFields :: HsDocContext
-> [FieldLabel]
-> [LHsConDeclRecField GhcPs]
-> RnM ([LHsConDeclRecField GhcRn], FreeNames)
rnHsConDeclRecFields HsDocContext
ctxt [FieldLabel]
fls [LHsConDeclRecField GhcPs]
fields
   = (GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)
 -> RnM
      (GenLocated SrcSpanAnnA (HsConDeclRecField GhcRn), FreeNames))
-> [GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)]
-> RnM
     ([GenLocated SrcSpanAnnA (HsConDeclRecField GhcRn)], FreeNames)
forall (f :: * -> *) a b.
Traversable f =>
(a -> RnM (b, FreeNames)) -> f a -> RnM (f b, FreeNames)
mapFvRn (FastStringEnv FieldLabel
-> RnTyKiEnv
-> LHsConDeclRecField GhcPs
-> RnM (LHsConDeclRecField GhcRn, FreeNames)
rnField FastStringEnv FieldLabel
fl_env RnTyKiEnv
env) [LHsConDeclRecField GhcPs]
[GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)]
fields
  where
    env :: RnTyKiEnv
env    = HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody
    fl_env :: FastStringEnv FieldLabel
fl_env = [(FastString, FieldLabel)] -> FastStringEnv FieldLabel
forall a. [(FastString, a)] -> FastStringEnv a
mkFsEnv [ (FieldLabelString -> FastString
field_label (FieldLabelString -> FastString) -> FieldLabelString -> FastString
forall a b. (a -> b) -> a -> b
$ FieldLabel -> FieldLabelString
flLabel FieldLabel
fl, FieldLabel
fl) | FieldLabel
fl <- [FieldLabel]
fls ]

rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LHsConDeclRecField GhcPs
        -> RnM (LHsConDeclRecField GhcRn, FreeNames)
rnField :: FastStringEnv FieldLabel
-> RnTyKiEnv
-> LHsConDeclRecField GhcPs
-> RnM (LHsConDeclRecField GhcRn, FreeNames)
rnField FastStringEnv FieldLabel
fl_env RnTyKiEnv
env (L SrcSpanAnnA
l (HsConDeclRecField XConDeclRecField GhcPs
_ [LFieldOcc GhcPs]
names HsConDeclField GhcPs
ty))
  = do { let new_names :: [GenLocated SrcSpanAnnA (FieldOcc GhcRn)]
new_names = (GenLocated SrcSpanAnnA (FieldOcc GhcPs)
 -> GenLocated SrcSpanAnnA (FieldOcc GhcRn))
-> [GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
-> [GenLocated SrcSpanAnnA (FieldOcc GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map ((FieldOcc GhcPs -> FieldOcc GhcRn)
-> GenLocated SrcSpanAnnA (FieldOcc GhcPs)
-> GenLocated SrcSpanAnnA (FieldOcc GhcRn)
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FastStringEnv FieldLabel -> FieldOcc GhcPs -> FieldOcc GhcRn
lookupField FastStringEnv FieldLabel
fl_env)) [LFieldOcc GhcPs]
[GenLocated SrcSpanAnnA (FieldOcc GhcPs)]
names
       ; (new_ty, fvs) <- RnTyKiEnv
-> HsConDeclField GhcPs -> RnM (HsConDeclField GhcRn, FreeNames)
rnHsConDeclFieldTyKi RnTyKiEnv
env HsConDeclField GhcPs
ty
       ; return (L l (HsConDeclRecField noExtField new_names new_ty)
                , fvs) }

lookupField :: FastStringEnv FieldLabel -> FieldOcc GhcPs -> FieldOcc GhcRn
lookupField :: FastStringEnv FieldLabel -> FieldOcc GhcPs -> FieldOcc GhcRn
lookupField FastStringEnv FieldLabel
fl_env (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpanAnnN
lr RdrName
rdr)) =
    XCFieldOcc GhcRn -> LIdP GhcRn -> FieldOcc GhcRn
forall pass. XCFieldOcc pass -> LIdP pass -> FieldOcc pass
FieldOcc (OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
sel) (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
lr Name
sel)
  where
    lbl :: FastString
lbl = OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
rdr
    sel :: Name
sel = FieldLabel -> Name
flSelector
        (FieldLabel -> Name) -> FieldLabel -> Name
forall a b. (a -> b) -> a -> b
$ Maybe FieldLabel -> FieldLabel
forall a. HasCallStack => Maybe a -> a
expectJust
        (Maybe FieldLabel -> FieldLabel) -> Maybe FieldLabel -> FieldLabel
forall a b. (a -> b) -> a -> b
$ FastStringEnv FieldLabel -> FastString -> Maybe FieldLabel
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv FastStringEnv FieldLabel
fl_env FastString
lbl

{-
************************************************************************
*                                                                      *
        Fixities and precedence parsing
*                                                                      *
************************************************************************

@mkOpAppRn@ deals with operator fixities.  The argument expressions
are assumed to be already correctly arranged.  It needs the fixities
recorded in the OpApp nodes, because fixity info applies to the things
the programmer actually wrote, so you can't find it out from the Name.

Furthermore, the second argument is guaranteed not to be another
operator application.  Why? Because the parser parses all
operator applications left-associatively, EXCEPT negation, which
we need to handle specially.
Infix types are read in a *right-associative* way, so that
        a `op` b `op` c
is always read in as
        a `op` (b `op` c)

mkHsOpTyRn rearranges where necessary.  The two arguments
have already been renamed and rearranged.

In the past, mkHsOpTyRn used to handle (->), but this was unnecessary. In the
syntax tree produced by the parser, the arrow already has the least possible
precedence and does not require rearrangement.
-}

---------------
-- Building (ty1 `op1` (ty2a `op2` ty2b))
mkHsOpTyRn :: LHsType GhcRn
           -> Fixity -> LHsType GhcRn -> LHsType GhcRn
           -> RnM (HsType GhcRn)

mkHsOpTyRn :: LHsType GhcRn
-> Fixity -> LHsType GhcRn -> LHsType GhcRn -> RnM (HsType GhcRn)
mkHsOpTyRn LHsType GhcRn
tyop1 Fixity
fix1 LHsType GhcRn
ty1 (L SrcSpanAnnA
loc2 (HsOpTy XOpTy GhcRn
_ LHsType GhcRn
ty2a LHsType GhcRn
tyop2 LHsType GhcRn
ty2b))
  = do  { fix2 <- LHsType GhcRn -> RnM Fixity
lookupTypeFixityRn LHsType GhcRn
tyop2
        ; mk_hs_op_ty tyop1 fix1 ty1 tyop2 fix2 ty2a ty2b loc2 }

mkHsOpTyRn LHsType GhcRn
tyop Fixity
_ LHsType GhcRn
ty1 LHsType GhcRn
ty2              -- Default case, no rearrangement
  = HsType GhcRn -> RnM (HsType GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpTy GhcRn
-> LHsType GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XOpTy pass
-> LHsType pass -> LHsType pass -> LHsType pass -> HsType pass
HsOpTy XOpTy GhcRn
NoExtField
noExtField LHsType GhcRn
ty1 LHsType GhcRn
tyop LHsType GhcRn
ty2)

---------------
mk_hs_op_ty :: LHsType GhcRn -> Fixity -> LHsType GhcRn
            -> LHsType GhcRn -> Fixity -> LHsType GhcRn
            -> LHsType GhcRn -> SrcSpanAnnA
            -> RnM (HsType GhcRn)
mk_hs_op_ty :: LHsType GhcRn
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> SrcSpanAnnA
-> RnM (HsType GhcRn)
mk_hs_op_ty LHsType GhcRn
tyop1 Fixity
fix1 LHsType GhcRn
ty1 LHsType GhcRn
tyop2 Fixity
fix2 LHsType GhcRn
ty2a LHsType GhcRn
ty2b SrcSpanAnnA
loc2
  | Bool
nofix_error     = do { (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (LHsType GhcRn -> OpName
get_tyop LHsType GhcRn
tyop1,Fixity
fix1)
                                        (LHsType GhcRn -> OpName
get_tyop LHsType GhcRn
tyop2,Fixity
fix2)
                         ; HsType GhcRn -> RnM (HsType GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty1 GenLocated SrcSpanAnnA (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
`op1ty` (SrcSpanAnnA
-> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc2 (LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty2a GenLocated SrcSpanAnnA (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
`op2ty` LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty2b))) }
  | Bool
associate_right = HsType GhcRn -> RnM (HsType GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty1 GenLocated SrcSpanAnnA (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
`op1ty` (SrcSpanAnnA
-> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc2 (LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty2a GenLocated SrcSpanAnnA (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
`op2ty` LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty2b)))
  | Bool
otherwise       = do { -- Rearrange to ((ty1 `op1` ty2a) `op2` ty2b)
                           new_ty <- LHsType GhcRn
-> Fixity -> LHsType GhcRn -> LHsType GhcRn -> RnM (HsType GhcRn)
mkHsOpTyRn LHsType GhcRn
tyop1 Fixity
fix1 LHsType GhcRn
ty1 LHsType GhcRn
ty2a
                         ; return (noLocA new_ty `op2ty` ty2b) }
  where
    GenLocated SrcSpanAnnA (HsType GhcRn)
lhs op1ty :: GenLocated SrcSpanAnnA (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
`op1ty` GenLocated SrcSpanAnnA (HsType GhcRn)
rhs = XOpTy GhcRn
-> LHsType GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XOpTy pass
-> LHsType pass -> LHsType pass -> LHsType pass -> HsType pass
HsOpTy XOpTy GhcRn
NoExtField
noExtField LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
lhs LHsType GhcRn
tyop1 LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
rhs
    GenLocated SrcSpanAnnA (HsType GhcRn)
lhs op2ty :: GenLocated SrcSpanAnnA (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
`op2ty` GenLocated SrcSpanAnnA (HsType GhcRn)
rhs = XOpTy GhcRn
-> LHsType GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XOpTy pass
-> LHsType pass -> LHsType pass -> LHsType pass -> HsType pass
HsOpTy XOpTy GhcRn
NoExtField
noExtField LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
lhs LHsType GhcRn
tyop2 LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
rhs
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2


---------------------------
mkOpAppRn :: NegationHandling
          -> LHsExpr GhcRn             -- Left operand; already rearranged
          -> LHsExpr GhcRn -> Fixity   -- Operator and fixity
          -> LHsExpr GhcRn             -- Right operand (not an OpApp, but might
                                       -- be a NegApp)
          -> RnM (HsExpr GhcRn)

-- (e1a `op1` e1b) `op2` e2
mkOpAppRn :: NegationHandling
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> Fixity
-> LHsExpr GhcRn
-> RnM (HsExpr GhcRn)
mkOpAppRn NegationHandling
negation_handling e1 :: LHsExpr GhcRn
e1@(L SrcSpanAnnA
_ (OpApp XOpApp GhcRn
fix1 LHsExpr GhcRn
e1a LHsExpr GhcRn
op1 LHsExpr GhcRn
e1b)) LHsExpr GhcRn
op2 Fixity
fix2 LHsExpr GhcRn
e2
  | Bool
nofix_error
  = do (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op1,Fixity
XOpApp GhcRn
fix1) (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op2,Fixity
fix2)
       HsExpr GhcRn -> RnM (HsExpr GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpApp GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp Fixity
XOpApp GhcRn
fix2 LHsExpr GhcRn
e1 LHsExpr GhcRn
op2 LHsExpr GhcRn
e2)

  | Bool
associate_right = do
    new_e <- NegationHandling
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> Fixity
-> LHsExpr GhcRn
-> RnM (HsExpr GhcRn)
mkOpAppRn NegationHandling
negation_handling LHsExpr GhcRn
e1b LHsExpr GhcRn
op2 Fixity
fix2 LHsExpr GhcRn
e2
    return (OpApp fix1 e1a op1 (L loc' new_e))
  where
    loc' :: SrcSpanAnnA
loc'= GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (EpAnn a) e1 -> GenLocated (EpAnn a) e2 -> EpAnn a
combineLocsA LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e1b LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e2
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
XOpApp GhcRn
fix1 Fixity
fix2

---------------------------
--      (- neg_arg) `op` e2
mkOpAppRn NegationHandling
ReassociateNegation e1 :: LHsExpr GhcRn
e1@(L SrcSpanAnnA
_ (NegApp XNegApp GhcRn
_ LHsExpr GhcRn
neg_arg SyntaxExpr GhcRn
neg_name)) LHsExpr GhcRn
op2 Fixity
fix2 LHsExpr GhcRn
e2
  | Bool
nofix_error
  = do (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (OpName
NegateOp,Fixity
negateFixity) (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op2,Fixity
fix2)
       HsExpr GhcRn -> RnM (HsExpr GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpApp GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp Fixity
XOpApp GhcRn
fix2 LHsExpr GhcRn
e1 LHsExpr GhcRn
op2 LHsExpr GhcRn
e2)

  | Bool
associate_right
  = do new_e <- NegationHandling
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> Fixity
-> LHsExpr GhcRn
-> RnM (HsExpr GhcRn)
mkOpAppRn NegationHandling
ReassociateNegation LHsExpr GhcRn
neg_arg LHsExpr GhcRn
op2 Fixity
fix2 LHsExpr GhcRn
e2
       return (NegApp noExtField (L loc' new_e) neg_name)
  where
    loc' :: SrcSpanAnnA
loc' = GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (EpAnn a) e1 -> GenLocated (EpAnn a) e2 -> EpAnn a
combineLocsA LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
neg_arg LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e2
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
negateFixity Fixity
fix2

---------------------------
--      e1 `op` - neg_arg
mkOpAppRn NegationHandling
ReassociateNegation LHsExpr GhcRn
e1 LHsExpr GhcRn
op1 Fixity
fix1 e2 :: LHsExpr GhcRn
e2@(L SrcSpanAnnA
_ (NegApp {})) -- NegApp can occur on the right
  | Bool -> Bool
not Bool
associate_right                        -- We *want* right association
  = do (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op1, Fixity
fix1) (OpName
NegateOp, Fixity
negateFixity)
       HsExpr GhcRn -> RnM (HsExpr GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpApp GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp Fixity
XOpApp GhcRn
fix1 LHsExpr GhcRn
e1 LHsExpr GhcRn
op1 LHsExpr GhcRn
e2)
  where
    (Bool
_, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
negateFixity

---------------------------
--      Default case
mkOpAppRn NegationHandling
_ LHsExpr GhcRn
e1 LHsExpr GhcRn
op Fixity
fix LHsExpr GhcRn
e2                  -- Default case, no rearrangement
  = Bool -> SDoc -> RnM (HsExpr GhcRn) -> RnM (HsExpr GhcRn)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Fixity -> HsExpr GhcRn -> Bool
right_op_ok Fixity
fix (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e2))
              (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e1 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"---" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"---" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fix SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"---" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e2) (RnM (HsExpr GhcRn) -> RnM (HsExpr GhcRn))
-> RnM (HsExpr GhcRn) -> RnM (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$
    HsExpr GhcRn -> RnM (HsExpr GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpApp GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp Fixity
XOpApp GhcRn
fix LHsExpr GhcRn
e1 LHsExpr GhcRn
op LHsExpr GhcRn
e2)

data NegationHandling = ReassociateNegation | KeepNegationIntact

----------------------------

get_op :: LHsExpr GhcRn -> OpName
-- An unbound name could be either HsVar or (HsHole (HoleVar _, _))
-- See GHC.Rename.Expr.rnUnboundVar
get_op :: LHsExpr GhcRn -> OpName
get_op (L SrcSpanAnnA
_ (HsVar XVar GhcRn
_ LIdOccP GhcRn
n))                 = WithUserRdr Name -> OpName
NormalOp (GenLocated SrcSpanAnnN (WithUserRdr Name) -> WithUserRdr Name
forall l e. GenLocated l e -> e
unLoc LIdOccP GhcRn
GenLocated SrcSpanAnnN (WithUserRdr Name)
n)
get_op (L SrcSpanAnnA
_ (HsHole (HoleVar (L SrcSpanAnnN
_ RdrName
uv)))) = RdrName -> OpName
UnboundOp RdrName
uv
get_op (L SrcSpanAnnA
_ (XExpr (HsRecSelRn FieldOcc GhcRn
fld)))    = FieldOcc GhcRn -> OpName
RecFldOp FieldOcc GhcRn
fld
get_op LHsExpr GhcRn
other                             = String -> SDoc -> OpName
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"get_op" (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
other)

get_tyop :: LHsType GhcRn -> OpName
get_tyop :: LHsType GhcRn -> OpName
get_tyop (L SrcSpanAnnA
_ (HsTyVar XTyVar GhcRn
_ PromotionFlag
_ LIdOccP GhcRn
n))  = WithUserRdr Name -> OpName
NormalOp (GenLocated SrcSpanAnnN (WithUserRdr Name) -> WithUserRdr Name
forall l e. GenLocated l e -> e
unLoc LIdOccP GhcRn
GenLocated SrcSpanAnnN (WithUserRdr Name)
n)
get_tyop (L SrcSpanAnnA
_ (HsWildCardTy XWildCardTy GhcRn
_)) = RdrName -> OpName
UnboundOp (OccName -> RdrName
Unqual (String -> OccName
mkVarOcc String
"_"))
get_tyop LHsType GhcRn
other                  = String -> SDoc -> OpName
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"get_tyop" (GenLocated SrcSpanAnnA (HsType GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
other)

-- Parser left-associates everything, but
-- derived instances may have correctly-associated things to
-- in the right operand.  So we just check that the right operand is OK
right_op_ok :: Fixity -> HsExpr GhcRn -> Bool
right_op_ok :: Fixity -> HsExpr GhcRn -> Bool
right_op_ok Fixity
fix1 (OpApp XOpApp GhcRn
fix2 LHsExpr GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
_)
  = Bool -> Bool
not Bool
error_please Bool -> Bool -> Bool
&& Bool
associate_right
  where
    (Bool
error_please, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
XOpApp GhcRn
fix2
right_op_ok Fixity
_ HsExpr GhcRn
_
  = Bool
True

-- Parser initially makes negation bind more tightly than any other operator
-- And "deriving" code should respect this (use HsPar if not)
mkNegAppRn :: LHsExpr GhcRn -> SyntaxExpr GhcRn -> RnM (HsExpr GhcRn)
mkNegAppRn :: LHsExpr GhcRn -> SyntaxExpr GhcRn -> RnM (HsExpr GhcRn)
mkNegAppRn LHsExpr GhcRn
neg_arg SyntaxExpr GhcRn
neg_name
  = Bool -> RnM (HsExpr GhcRn) -> RnM (HsExpr GhcRn)
forall a. HasCallStack => Bool -> a -> a
assert (HsExpr GhcRn -> Bool
forall id. HsExpr id -> Bool
not_op_app (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
neg_arg)) (RnM (HsExpr GhcRn) -> RnM (HsExpr GhcRn))
-> RnM (HsExpr GhcRn) -> RnM (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$
    HsExpr GhcRn -> RnM (HsExpr GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XNegApp GhcRn -> LHsExpr GhcRn -> SyntaxExpr GhcRn -> HsExpr GhcRn
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp XNegApp GhcRn
NoExtField
noExtField LHsExpr GhcRn
neg_arg SyntaxExpr GhcRn
neg_name)

not_op_app :: HsExpr id -> Bool
not_op_app :: forall id. HsExpr id -> Bool
not_op_app (OpApp {}) = Bool
False
not_op_app HsExpr id
_          = Bool
True

--------------------------------------
mkConOpPatRn :: LocatedN (WithUserRdr Name)
             -> Fixity -> LPat GhcRn -> LPat GhcRn
             -> RnM (Pat GhcRn)

mkConOpPatRn :: GenLocated SrcSpanAnnN (WithUserRdr Name)
-> Fixity -> LPat GhcRn -> LPat GhcRn -> RnM (Pat GhcRn)
mkConOpPatRn GenLocated SrcSpanAnnN (WithUserRdr Name)
op2 Fixity
fix2 p1 :: LPat GhcRn
p1@(L SrcSpanAnnA
loc (ConPat XConPat GhcRn
NoExtField
NoExtField XRec GhcRn (ConLikeP GhcRn)
op1 (InfixCon LPat GhcRn
p1a LPat GhcRn
p1b))) LPat GhcRn
p2
  = do  { fix1 <- Name -> RnM Fixity
lookupFixityRn (GenLocated SrcSpanAnnN (WithUserRdr Name) -> Name
forall a. NamedThing a => a -> Name
getName XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN (WithUserRdr Name)
op1)
        ; let (nofix_error, associate_right) = compareFixity fix1 fix2

        ; if nofix_error then do
                { precParseErr (NormalOp (unLoc op1),fix1)
                               (NormalOp (unLoc op2),fix2)
                ; return $ ConPat
                    { pat_con_ext = noExtField
                    , pat_con  = op2
                    , pat_args = InfixCon p1 p2
                    }
                }

          else if associate_right then do
                { new_p <- mkConOpPatRn op2 fix2 p1b p2
                ; return $ ConPat
                    { pat_con_ext = noExtField
                    , pat_con = op1
                    , pat_args = InfixCon p1a (L loc new_p)
                    }
                }
                -- XXX loc right?
          else return $ ConPat
                 { pat_con_ext = noExtField
                 , pat_con = op2
                 , pat_args = InfixCon p1 p2
                 }
        }

mkConOpPatRn GenLocated SrcSpanAnnN (WithUserRdr Name)
op Fixity
_ LPat GhcRn
p1 LPat GhcRn
p2                         -- Default case, no rearrangement
  = Bool -> RnM (Pat GhcRn) -> RnM (Pat GhcRn)
forall a. HasCallStack => Bool -> a -> a
assert (Pat GhcRn -> Bool
not_op_pat (GenLocated SrcSpanAnnA (Pat GhcRn) -> Pat GhcRn
forall l e. GenLocated l e -> e
unLoc LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
p2)) (RnM (Pat GhcRn) -> RnM (Pat GhcRn))
-> RnM (Pat GhcRn) -> RnM (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$
    Pat GhcRn -> RnM (Pat GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat GhcRn -> RnM (Pat GhcRn)) -> Pat GhcRn -> RnM (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$ ConPat
      { pat_con_ext :: XConPat GhcRn
pat_con_ext = XConPat GhcRn
NoExtField
noExtField
      , pat_con :: XRec GhcRn (ConLikeP GhcRn)
pat_con = XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN (WithUserRdr Name)
op
      , pat_args :: HsConDetails (LPat GhcRn) (HsRecFields GhcRn (LPat GhcRn))
pat_args = GenLocated SrcSpanAnnA (Pat GhcRn)
-> GenLocated SrcSpanAnnA (Pat GhcRn)
-> HsConDetails
     (GenLocated SrcSpanAnnA (Pat GhcRn))
     (HsRecFields GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
p1 LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
p2
      }

not_op_pat :: Pat GhcRn -> Bool
not_op_pat :: Pat GhcRn -> Bool
not_op_pat (ConPat XConPat GhcRn
NoExtField
NoExtField XRec GhcRn (ConLikeP GhcRn)
_ (InfixCon LPat GhcRn
_ LPat GhcRn
_)) = Bool
False
not_op_pat Pat GhcRn
_                                    = Bool
True

--------------------------------------
checkPrecMatch :: Name -> MatchGroup GhcRn body -> RnM ()
  -- Check precedence of a function binding written infix
  --   eg  a `op` b `C` c = ...
  -- See comments with rnExpr (OpApp ...) about "deriving"

checkPrecMatch :: forall body. Name -> MatchGroup GhcRn body -> TcRn ()
checkPrecMatch Name
op (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L Anno [GenLocated (Anno (Match GhcRn body)) (Match GhcRn body)]
_ [GenLocated (Anno (Match GhcRn body)) (Match GhcRn body)]
ms) })
  = (GenLocated (Anno (Match GhcRn body)) (Match GhcRn body)
 -> TcRn ())
-> [GenLocated (Anno (Match GhcRn body)) (Match GhcRn body)]
-> TcRn ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GenLocated (Anno (Match GhcRn body)) (Match GhcRn body) -> TcRn ()
check [GenLocated (Anno (Match GhcRn body)) (Match GhcRn body)]
ms
  where
    check :: GenLocated (Anno (Match GhcRn body)) (Match GhcRn body) -> TcRn ()
check (L Anno (Match GhcRn body)
_ (Match { m_pats :: forall p body. Match p body -> XRec p [LPat p]
m_pats = L EpaLocation
_ ( (L SrcSpanAnnA
l1 Pat GhcRn
p1)
                                     : (L SrcSpanAnnA
l2 Pat GhcRn
p2)
                                     : [GenLocated SrcSpanAnnA (Pat GhcRn)]
_) }))
      = SrcSpan -> TcRn () -> TcRn ()
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA (SrcSpanAnnA -> SrcSpan) -> SrcSpanAnnA -> SrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => EpAnn a -> EpAnn a -> EpAnn a
combineSrcSpansA SrcSpanAnnA
l1 SrcSpanAnnA
l2) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
        do Name -> Pat GhcRn -> Bool -> TcRn ()
checkPrec Name
op Pat GhcRn
p1 Bool
False
           Name -> Pat GhcRn -> Bool -> TcRn ()
checkPrec Name
op Pat GhcRn
p2 Bool
True

    check GenLocated (Anno (Match GhcRn body)) (Match GhcRn body)
_ = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- This can happen.  Consider
        --      a `op` True = ...
        --      op          = ...
        -- The infix flag comes from the first binding of the group
        -- but the second eqn has no args (an error, but not discovered
        -- until the type checker).  So we don't want to crash on the
        -- second eqn.

checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkPrec :: Name -> Pat GhcRn -> Bool -> TcRn ()
checkPrec Name
op (ConPat XConPat GhcRn
NoExtField
NoExtField XRec GhcRn (ConLikeP GhcRn)
op1 (InfixCon LPat GhcRn
_ LPat GhcRn
_)) Bool
right = do
    op_fix@(Fixity op_prec  op_dir) <- Name -> RnM Fixity
lookupFixityRn Name
op
    op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (getName op1)
    let
        inf_ok = Int
op1_prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
op_prec Bool -> Bool -> Bool
||
                 (Int
op1_prec Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
op_prec Bool -> Bool -> Bool
&&
                  (FixityDirection
op1_dir FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
InfixR Bool -> Bool -> Bool
&& FixityDirection
op_dir FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
InfixR Bool -> Bool -> Bool
&& Bool
right Bool -> Bool -> Bool
||
                   FixityDirection
op1_dir FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
InfixL Bool -> Bool -> Bool
&& FixityDirection
op_dir FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
InfixL Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
right))

        info  = (WithUserRdr Name -> OpName
NormalOp (Name -> WithUserRdr Name
noUserRdr Name
op), Fixity
op_fix)
        info1 = (WithUserRdr Name -> OpName
NormalOp (GenLocated SrcSpanAnnN (WithUserRdr Name) -> WithUserRdr Name
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN (WithUserRdr Name)
op1), Fixity
op1_fix)
        (infol, infor) = if right then (info, info1) else (info1, info)
    unless inf_ok (precParseErr infol infor)

checkPrec Name
_ Pat GhcRn
_ Bool
_
  = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Check precedence of (arg op) or (op arg) respectively
-- If arg is itself an operator application, then either
--   (a) its precedence must be higher than that of op
--   (b) its precedency & associativity must be the same as that of op
checkSectionPrec :: FixityDirection -> HsExpr GhcPs
        -> LHsExpr GhcRn -> LHsExpr GhcRn -> RnM ()
checkSectionPrec :: FixityDirection
-> HsExpr GhcPs -> LHsExpr GhcRn -> LHsExpr GhcRn -> TcRn ()
checkSectionPrec FixityDirection
direction HsExpr GhcPs
section LHsExpr GhcRn
op LHsExpr GhcRn
arg
  = case GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
arg of
        OpApp XOpApp GhcRn
fix LHsExpr GhcRn
_ LHsExpr GhcRn
op' LHsExpr GhcRn
_ -> OpName -> Fixity -> TcRn ()
go_for_it (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op') Fixity
XOpApp GhcRn
fix
        NegApp XNegApp GhcRn
_ LHsExpr GhcRn
_ SyntaxExpr GhcRn
_      -> OpName -> Fixity -> TcRn ()
go_for_it OpName
NegateOp     Fixity
negateFixity
        HsExpr GhcRn
_                 -> () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    op_name :: OpName
op_name = LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op
    go_for_it :: OpName -> Fixity -> TcRn ()
go_for_it OpName
arg_op arg_fix :: Fixity
arg_fix@(Fixity Int
arg_prec FixityDirection
assoc) = do
          op_fix@(Fixity op_prec _) <- OpName -> RnM Fixity
lookupFixityOp OpName
op_name
          unless (op_prec < arg_prec
                  || (op_prec == arg_prec && direction == assoc))
                 (sectionPrecErr (get_op op, op_fix)
                                 (arg_op, arg_fix) section)

-- | Look up the fixity for an operator name.
lookupFixityOp :: OpName -> RnM Fixity
lookupFixityOp :: OpName -> RnM Fixity
lookupFixityOp (NormalOp WithUserRdr Name
n)  = Name -> RnM Fixity
lookupFixityRn (WithUserRdr Name -> Name
forall a. NamedThing a => a -> Name
getName WithUserRdr Name
n)
lookupFixityOp OpName
NegateOp      = Name -> RnM Fixity
lookupFixityRn Name
negateName
lookupFixityOp (UnboundOp RdrName
u) = Name -> RnM Fixity
lookupFixityRn (OccName -> Name
mkUnboundName (RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName RdrName
u))
lookupFixityOp (RecFldOp FieldOcc GhcRn
f)  = FieldOcc GhcRn -> RnM Fixity
lookupFieldFixityRn FieldOcc GhcRn
f

-- Precedence-related error messages

precParseErr :: (OpName,Fixity) -> (OpName,Fixity) -> RnM ()
precParseErr :: (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr op1 :: (OpName, Fixity)
op1@(OpName
n1,Fixity
_) op2 :: (OpName, Fixity)
op2@(OpName
n2,Fixity
_)
  | OpName -> Bool
is_unbound OpName
n1 Bool -> Bool -> Bool
|| OpName -> Bool
is_unbound OpName
n2
  = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()     -- Avoid error cascade
  | Bool
otherwise
  = TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ (OpName, Fixity) -> (OpName, Fixity) -> TcRnMessage
TcRnPrecedenceParsingError (OpName, Fixity)
op1 (OpName, Fixity)
op2

sectionPrecErr :: (OpName,Fixity) -> (OpName,Fixity) -> HsExpr GhcPs -> RnM ()
sectionPrecErr :: (OpName, Fixity) -> (OpName, Fixity) -> HsExpr GhcPs -> TcRn ()
sectionPrecErr op :: (OpName, Fixity)
op@(OpName
n1,Fixity
_) arg_op :: (OpName, Fixity)
arg_op@(OpName
n2,Fixity
_) HsExpr GhcPs
section
  | OpName -> Bool
is_unbound OpName
n1 Bool -> Bool -> Bool
|| OpName -> Bool
is_unbound OpName
n2
  = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()     -- Avoid error cascade
  | Bool
otherwise
  = TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ (OpName, Fixity) -> (OpName, Fixity) -> HsExpr GhcPs -> TcRnMessage
TcRnSectionPrecedenceError (OpName, Fixity)
op (OpName, Fixity)
arg_op HsExpr GhcPs
section

is_unbound :: OpName -> Bool
is_unbound :: OpName -> Bool
is_unbound (NormalOp WithUserRdr Name
n) = Name -> Bool
isUnboundName (WithUserRdr Name -> Name
forall a. NamedThing a => a -> Name
getName WithUserRdr Name
n)
is_unbound UnboundOp{}  = Bool
True
is_unbound OpName
_            = Bool
False


{- *****************************************************
*                                                      *
                 Errors
*                                                      *
***************************************************** -}

unexpectedPatSigTypeErr :: HsPatSigType GhcPs -> TcRnMessage
unexpectedPatSigTypeErr :: HsPatSigType GhcPs -> TcRnMessage
unexpectedPatSigTypeErr HsPatSigType GhcPs
ty
  = HsPatSigType GhcPs -> TcRnMessage
TcRnUnexpectedPatSigType HsPatSigType GhcPs
ty

badKindSigErr :: HsDocContext -> LHsType GhcPs -> TcM ()
badKindSigErr :: HsDocContext -> LHsType GhcPs -> TcRn ()
badKindSigErr HsDocContext
doc (L SrcSpanAnnA
loc HsType GhcPs
ty)
  = SrcSpanAnnA -> TcRn () -> TcRn ()
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$
    HsDocContext -> TcRnMessage -> TcRnMessage
TcRnWithHsDocContext HsDocContext
doc (TcRnMessage -> TcRnMessage) -> TcRnMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
    Either (HsType GhcPs) (Name, HsType GhcRn) -> TcRnMessage
TcRnKindSignaturesDisabled (HsType GhcPs -> Either (HsType GhcPs) (Name, HsType GhcRn)
forall a b. a -> Either a b
Left HsType GhcPs
ty)

-- | Check for DataKinds violations in a type context, as well as \"obvious\"
-- violations in kind contexts.
-- See @Note [Checking for DataKinds]@ in "GHC.Tc.Validity" for more on this.
checkDataKinds :: RnTyKiEnv -> HsType GhcPs -> TcM ()
checkDataKinds :: RnTyKiEnv -> HsType GhcPs -> TcRn ()
checkDataKinds RnTyKiEnv
env HsType GhcPs
thing
  = do data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
       unless data_kinds $
         addErr $ TcRnDataKindsError type_or_kind $ Left thing
  where
    type_or_kind :: TypeOrKind
type_or_kind | RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env = TypeOrKind
KindLevel
                 | Bool
otherwise         = TypeOrKind
TypeLevel

-- | If a 'Name' is that of a promoted data constructor, perform various
-- validity checks on it.
checkPromotedDataConName ::
  RnTyKiEnv ->
  -- | The type that the 'Name' belongs to. This will always be an 'HsTyVar'
  -- (for 'Prefix' names) or an 'HsOpTy' (for 'Infix' names).
  HsType GhcPs ->
  -- | Whether the type is written 'Prefix' or 'Infix'.
  LexicalFixity ->
  -- | Whether the name was written with an explicit promotion tick or not.
  PromotionFlag ->
  -- | The name to check.
  Name ->
  TcM ()
checkPromotedDataConName :: RnTyKiEnv
-> HsType GhcPs
-> LexicalFixity
-> PromotionFlag
-> Name
-> TcRn ()
checkPromotedDataConName RnTyKiEnv
env HsType GhcPs
ty LexicalFixity
fixity PromotionFlag
ip Name
name
  = do Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
isDataConName Name
name Bool -> Bool -> Bool
&& Bool -> Bool
not (Name -> Bool
isKindName Name
name)) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
         -- Any use of a promoted data constructor name (that is not
         -- specifically exempted by isKindName) is illegal without the use
         -- of DataKinds. See Note [Checking for DataKinds] in
         -- GHC.Tc.Validity.
         RnTyKiEnv -> HsType GhcPs -> TcRn ()
checkDataKinds RnTyKiEnv
env HsType GhcPs
ty
       Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
isDataConName Name
name Bool -> Bool -> Bool
&& Bool -> Bool
not (PromotionFlag -> Bool
isPromoted PromotionFlag
ip)) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
         TcRnMessage -> TcRn ()
addDiagnostic (UntickedPromotedThing -> TcRnMessage
UntickedPromotedThing -> TcRnMessage
TcRnUntickedPromotedThing (UntickedPromotedThing -> TcRnMessage)
-> UntickedPromotedThing -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ LexicalFixity -> Name -> UntickedPromotedThing
UntickedConstructor LexicalFixity
fixity Name
name)

warnUnusedForAll :: OutputableBndrFlag flag 'Renamed
                 => HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeNames -> TcM ()
warnUnusedForAll :: forall flag.
OutputableBndrFlag flag 'Renamed =>
HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeNames -> TcRn ()
warnUnusedForAll HsDocContext
doc (L SrcSpanAnnA
loc HsTyVarBndr flag GhcRn
tvb) FreeNames
used_names =
  case HsTyVarBndr flag GhcRn -> HsBndrVar GhcRn
forall flag (pass :: Pass).
HsTyVarBndr flag (GhcPass pass) -> HsBndrVar (GhcPass pass)
hsBndrVar HsTyVarBndr flag GhcRn
tvb of
    HsBndrWildCard XBndrWildCard GhcRn
_ -> () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    HsBndrVar XBndrVar GhcRn
_ (L SrcSpanAnnN
_ Name
tv) ->
      Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Name
tv Name -> FreeNames -> Bool
`elemNameSet` FreeNames
used_names) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ do
        let msg :: TcRnMessage
msg = HsDocContext -> HsTyVarBndrExistentialFlag -> TcRnMessage
TcRnUnusedQuantifiedTypeVar HsDocContext
doc (HsTyVarBndr flag GhcRn -> HsTyVarBndrExistentialFlag
forall flag.
OutputableBndrFlag flag 'Renamed =>
HsTyVarBndr flag GhcRn -> HsTyVarBndrExistentialFlag
HsTyVarBndrExistentialFlag HsTyVarBndr flag GhcRn
tvb)
        SrcSpan -> TcRnMessage -> TcRn ()
addDiagnosticAt (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) TcRnMessage
msg

warnCapturedTerm :: LocatedN RdrName -> Either [GlobalRdrElt] Name -> TcM ()
warnCapturedTerm :: GenLocated SrcSpanAnnN RdrName
-> Either [GlobalRdrElt] Name -> TcRn ()
warnCapturedTerm (L SrcSpanAnnN
loc RdrName
tv) Either [GlobalRdrElt] Name
shadowed_term_names
  = let msg :: TcRnMessage
msg = RdrName -> Either [GlobalRdrElt] Name -> TcRnMessage
TcRnCapturedTermName RdrName
tv Either [GlobalRdrElt] Name
shadowed_term_names
    in SrcSpan -> TcRnMessage -> TcRn ()
addDiagnosticAt (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc) TcRnMessage
msg

{-
************************************************************************
*                                                                      *
      Finding the free type variables of a (HsType RdrName)
*                                                                      *
************************************************************************


Note [Kind and type-variable binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In a type signature we may implicitly bind type/kind variables. For example:
  *   f :: a -> a
      f = ...
    Here we need to find the free type variables of (a -> a),
    so that we know what to quantify

  *   class C (a :: k) where ...
    This binds 'k' in ..., as well as 'a'

  *   f (x :: a -> [a]) = ....
    Here we bind 'a' in ....

  *   f (x :: T a -> T (b :: k)) = ...
    Here we bind both 'a' and the kind variable 'k'

  *   type instance F (T (a :: Maybe k)) = ...a...k...
    Here we want to constrain the kind of 'a', and bind 'k'.

To do that, we need to walk over a type and find its free type/kind variables.
We preserve the left-to-right order of each variable occurrence.
See Note [Ordering of implicit variables].

It is common for lists of free type variables to contain duplicates. For
example, in `f :: a -> a`, the free type variable list is [a, a]. When these
implicitly bound variables are brought into scope (with rnImplicitTvOccs),
duplicates are removed with nubL.

Note [Ordering of implicit variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Since the advent of -XTypeApplications, GHC makes promises about the ordering
of implicit variable quantification. Specifically, we offer that implicitly
quantified variables (such as those in const :: a -> b -> a, without a `forall`)
will occur in left-to-right order of first occurrence. Here are a few examples:

  const :: a -> b -> a       -- forall a b. ...
  f :: Eq a => b -> a -> a   -- forall a b. ...  contexts are included

  type a <-< b = b -> a
  g :: a <-< b               -- forall a b. ...  type synonyms matter

  class Functor f where
    fmap :: (a -> b) -> f a -> f b   -- forall f a b. ...
    -- The f is quantified by the class, so only a and b are considered in fmap

This simple story is complicated by the possibility of dependency: all variables
must come after any variables mentioned in their kinds.

  typeRep :: Typeable a => TypeRep (a :: k)   -- forall k a. ...

The k comes first because a depends on k, even though the k appears later than
the a in the code. Thus, GHC does ScopedSort on the variables.
See Note [ScopedSort] in GHC.Core.Type.

Implicitly bound variables are collected by any function which returns a
FreeKiTyVars, which notably includes the `extract-` family of functions
(extractHsTysRdrTyVars, extractHsTyVarBndrsKVs, etc.).
These functions thus promise to keep left-to-right ordering.

Note that for 'HsFunTy m ty1 ty2', we quantify in the order ty1, m, ty2,
since this type is written ty1 %m -> ty2 in the source syntax.

Note [Implicit quantification in type synonyms]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We typically bind type/kind variables implicitly when they are in a kind
annotation on the LHS, for example:

  data Proxy (a :: k) = Proxy
  type KindOf (a :: k) = k

Here 'k' is in the kind annotation of a type variable binding, HsBndrKind, and
we want to implicitly quantify over it.  This is easy: just extract all free
variables from the kind signature. That's what we do in extract_hs_tv_bndrs_kvs

By contrast, on the RHS we can't simply collect *all* free variables. Which of
the following are allowed?

  type TySyn1 = a :: Type
  type TySyn2 = 'Nothing :: Maybe a
  type TySyn3 = 'Just ('Nothing :: Maybe a)
  type TySyn4 = 'Left a :: Either Type a

After some design deliberations (see non-taken alternatives below), the answer
is to reject TySyn1 and TySyn3, but allow TySyn2 and TySyn4, at least for now.
We implicitly quantify over free variables of the outermost kind signature, if
one exists:

  * In TySyn1, the outermost kind signature is (:: Type), and it does not have
    any free variables.
  * In TySyn2, the outermost kind signature is (:: Maybe a), it contains a
    free variable 'a', which we implicitly quantify over.
  * In TySyn3, there is no outermost kind signature. The (:: Maybe a) signature
    is hidden inside 'Just.
  * In TySyn4, the outermost kind signature is (:: Either Type a), it contains
    a free variable 'a', which we implicitly quantify over. That is why we can
    also use it to the left of the double colon: 'Left a

The logic resides in extractHsTyRdrTyVarsKindVars.

This was a stopgap solution until we could explicitly bind invisible
type/kind variables:

  type TySyn3 :: forall a. Maybe a
  type TySyn3 @a = 'Just ('Nothing :: Maybe a)

Now that the new syntax was proposed in #425 and implemented in 9.8, we issue a warning
-Wimplicit-rhs-quantification for TySyn2 and TySyn4 and will eventually disallow them.

Note [Implicit quantification in type synonyms: non-taken alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Alternative I: No quantification
--------------------------------
We could offer no implicit quantification on the RHS, accepting none of the
TySyn<N> examples. The user would have to bind the variables explicitly:

  type TySyn1 a = a :: Type
  type TySyn2 a = 'Nothing :: Maybe a
  type TySyn3 a = 'Just ('Nothing :: Maybe a)
  type TySyn4 a = 'Left a :: Either Type a

However, this would mean that one would have to specify 'a' at call sites every
time, which could be undesired.

Alternative II: Indiscriminate quantification
---------------------------------------------
We could implicitly quantify over all free variables on the RHS just like we do
on the LHS. Then we would infer the following kinds:

  TySyn1 :: forall {a}. Type
  TySyn2 :: forall {a}. Maybe a
  TySyn3 :: forall {a}. Maybe (Maybe a)
  TySyn4 :: forall {a}. Either Type a

This would work fine for TySyn<2,3,4>, but TySyn1 is clearly bogus: the variable
is free-floating, not fixed by anything.

Alternative III: reportFloatingKvs
----------------------------------
We could augment Alternative II by hunting down free-floating variables during
type checking. While viable, this would mean we'd end up accepting this:

  data Prox k (a :: k)
  type T = Prox k

-}

-- A list of free type/kind variables, which can contain duplicates.
-- See Note [Kind and type-variable binders]
-- These lists are guaranteed to preserve left-to-right ordering of
-- the types the variables were extracted from. See also
-- Note [Ordering of implicit variables].
type FreeKiTyVars = [LocatedN RdrName]

-- When renaming a type, do we want to capture or ignore term variables?
-- Suppose we have a variable binding `a` and we are renaming a type signature
-- that mentions `a`:
--
--    f :: forall t -> ...
--    f a = ...
--      where g :: a -> Bool
--
-- Does the `a` in the signature for `g` refer to the term variable or is it
-- implicitly quantified, as if the user wrote `g :: forall a. a -> Bool`?
-- `CaptureTermVars` selects the former behavior, `DontCaptureTermVars` the latter.
data TermVariableCapture =
    CaptureTermVars
  | DontCaptureTermVars

getTermVariableCapture :: RnM TermVariableCapture
getTermVariableCapture :: RnM TermVariableCapture
getTermVariableCapture
  = do { required_type_arguments <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RequiredTypeArguments
       ; let tvc | Bool
required_type_arguments = TermVariableCapture
CaptureTermVars
                 | Bool
otherwise               = TermVariableCapture
DontCaptureTermVars
       ; return tvc }

-- | Filter out any type and kind variables that are already in scope in the
-- the supplied LocalRdrEnv. Note that this includes named wildcards, which
-- look like perfectly ordinary type variables at this point.
filterInScope :: TermVariableCapture -> (GlobalRdrEnv, LocalRdrEnv) -> FreeKiTyVars -> FreeKiTyVars
filterInScope :: TermVariableCapture
-> (GlobalRdrEnv, LocalRdrEnv) -> FreeKiTyVars -> FreeKiTyVars
filterInScope TermVariableCapture
tvc (GlobalRdrEnv, LocalRdrEnv)
envs = (GenLocated SrcSpanAnnN RdrName -> Bool)
-> FreeKiTyVars -> FreeKiTyVars
forall a. (a -> Bool) -> [a] -> [a]
filterOut (TermVariableCapture
-> (GlobalRdrEnv, LocalRdrEnv) -> RdrName -> Bool
inScope TermVariableCapture
tvc (GlobalRdrEnv, LocalRdrEnv)
envs (RdrName -> Bool)
-> (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc)

-- | Like 'filterInScope', but keep parent class variables intact.
-- Used with associated types. See Note [Class variables and filterInScope]
filterInScopeNonClass :: [Name] -> TermVariableCapture -> (GlobalRdrEnv, LocalRdrEnv) -> FreeKiTyVars -> FreeKiTyVars
filterInScopeNonClass :: [Name]
-> TermVariableCapture
-> (GlobalRdrEnv, LocalRdrEnv)
-> FreeKiTyVars
-> FreeKiTyVars
filterInScopeNonClass [Name]
cls_tvs TermVariableCapture
tvc (GlobalRdrEnv, LocalRdrEnv)
envs = (GenLocated SrcSpanAnnN RdrName -> Bool)
-> FreeKiTyVars -> FreeKiTyVars
forall a. (a -> Bool) -> [a] -> [a]
filterOut (RdrName -> Bool
in_scope_non_class (RdrName -> Bool)
-> (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc)
  where
    in_scope_non_class :: RdrName -> Bool
    in_scope_non_class :: RdrName -> Bool
in_scope_non_class RdrName
rdr
      | RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName RdrName
rdr OccName -> OccSet -> Bool
`elemOccSet` OccSet
cls_tvs_set = Bool
False
      | Bool
otherwise = TermVariableCapture
-> (GlobalRdrEnv, LocalRdrEnv) -> RdrName -> Bool
inScope TermVariableCapture
tvc (GlobalRdrEnv, LocalRdrEnv)
envs RdrName
rdr

    cls_tvs_set :: OccSet
    cls_tvs_set :: OccSet
cls_tvs_set = [OccName] -> OccSet
mkOccSet ((Name -> OccName) -> [Name] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> OccName
nameOccName [Name]
cls_tvs)

-- | Filter out any type and kind variables that are already in scope in the
-- the environment's LocalRdrEnv. Note that this includes named wildcards,
-- which look like perfectly ordinary type variables at this point.
filterInScopeM :: FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM :: FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM FreeKiTyVars
vars
  = do { tvc <- RnM TermVariableCapture
getTermVariableCapture
       ; envs <- getRdrEnvs
       ; return (filterInScope tvc envs vars) }

-- | Like 'filterInScopeM', but keep parent class variables intact.
-- Used with associated types. See Note [Class variables and filterInScope]
filterInScopeNonClassM :: [Name] -> FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeNonClassM :: [Name] -> FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeNonClassM [Name]
cls_tvs FreeKiTyVars
vars
  = do { tvc <- RnM TermVariableCapture
getTermVariableCapture
       ; envs <- getRdrEnvs
       ; return (filterInScopeNonClass cls_tvs tvc envs vars) }

inScope :: TermVariableCapture -> (GlobalRdrEnv, LocalRdrEnv) -> RdrName -> Bool
inScope :: TermVariableCapture
-> (GlobalRdrEnv, LocalRdrEnv) -> RdrName -> Bool
inScope TermVariableCapture
tvc (GlobalRdrEnv
gbl, LocalRdrEnv
lcl) RdrName
rdr =
  case TermVariableCapture
tvc of
    TermVariableCapture
DontCaptureTermVars -> Bool
rdr_in_scope
    TermVariableCapture
CaptureTermVars     -> Bool
rdr_in_scope Bool -> Bool -> Bool
|| Bool
demoted_rdr_in_scope
  where
    rdr_in_scope, demoted_rdr_in_scope :: Bool
    rdr_in_scope :: Bool
rdr_in_scope         = RdrName -> Bool
elem_lcl RdrName
rdr
    demoted_rdr_in_scope :: Bool
demoted_rdr_in_scope = Bool -> (RdrName -> Bool) -> Maybe RdrName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (RdrName -> Bool
elem_lcl (RdrName -> Bool) -> (RdrName -> Bool) -> RdrName -> Bool
forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
<||> RdrName -> Bool
elem_gbl) (RdrName -> Maybe RdrName
demoteRdrNameTv RdrName
rdr)

    elem_lcl, elem_gbl :: RdrName -> Bool
    elem_lcl :: RdrName -> Bool
elem_lcl RdrName
name = RdrName -> LocalRdrEnv -> Bool
elemLocalRdrEnv RdrName
name LocalRdrEnv
lcl
    elem_gbl :: RdrName -> Bool
elem_gbl RdrName
name = (Bool -> Bool
not (Bool -> Bool)
-> ([GlobalRdrElt] -> Bool) -> [GlobalRdrElt] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
gbl (RdrName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName RdrName
name (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantBoth)))

{- Note [Class variables and filterInScope]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In `bindHsQTyVars` free variables are collected and bound implicitly. Example:
  type ElemKind (a :: Maybe k) = k
Both occurrences of `k` are usages, so GHC creates an implicit binding for `k`.
We can also bind it explicitly with the help of TypeAbstractions:
  type ElemKind @k (a :: Maybe k) = k

This is similar to implicit quantification that happens in type signatures
  const :: a -> b -> a               -- `a` and `b` bound implicitly
  const :: forall a b. a -> b -> a   -- `a` and `b` bound explicitly

In both cases we need to compute the list of free variables to implicitly
quantify over (NB: list, not set, because order matters with TypeApplications)
  * implicitly bound variables in ElemKind:  [k]
  * implicitly bound variables in const:     [a, b]

However, variables that are already in scope are captured. Example:
  {-# LANGUAGE ScopedTypeVariables #-}
  f (x :: a) = ...
    where g :: a -> a
          g _ = x
When we look at `g` in isolation, `a` is a free variable:
  g :: a -> a
But due to ScopedTypeVariables, `a` is actually bound in the surrounding
context, namely the (x :: a) pattern.
It is important that we do /not/ insert an implicit forall in the type of `g`
  g :: forall a. a -> a   -- No! That would mean a different thing
The solution is to use `filterInScopeM` to remove variables already in scope
from candidates for implicit quantification.

Using `filterInScopeM` is additionally important when RequiredTypeArguments is
in effect. Consider
  import Prelude (id)
  data T (a :: id) = MkT    -- Test case T23740e

With RequiredTypeArguments, variables in the term namespace can be referred to
at the type level, so `id` in the `:: id` kind signature ought to refer to `id`
from Prelude. Of course it is not a valid program, but we want a proper error
message rather than implicit quantification:
  T23740e.hs:5:14: error: [GHC-45510]
      • Term variable ‘id’ cannot be used here
          (term variables cannot be promoted)

This leads us to use `filterInScopeM` in `bindHsQTyVars`.
Unfortunately, associated types make matters more complex. Consider
  class C (a::k1) (b::k2) (c::k3) where
    type T (a::k1) b
When renaming `T`, we have to implicitly quantify over the class variable `k1`,
despite the fact that `k1` is in scope from the class header. The type checker
expects to find `k1` in `HsQTvsRn` (the `hsq_ext` field of `LHsQTyVars`). But it
won't find it there if it is filtered out by `filterInScopeM`.

To account for that, we introduce another helper, `filterInScopeNonClassM`,
which acts much like `filterInScopeM` but leaves class variables intact. -}

extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_tyarg (HsValArg XValArg GhcPs
_ LHsType GhcPs
ty) FreeKiTyVars
acc = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty FreeKiTyVars
acc
extract_tyarg (HsTypeArg XTypeArg GhcPs
_ LHsType GhcPs
ki) FreeKiTyVars
acc = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ki FreeKiTyVars
acc
extract_tyarg (HsArgPar XArgPar GhcPs
_) FreeKiTyVars
acc = FreeKiTyVars
acc

extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_tyargs [LHsTypeArg GhcPs]
args FreeKiTyVars
acc = (HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> FreeKiTyVars -> FreeKiTyVars)
-> FreeKiTyVars
-> [HsArg
      GhcPs
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> FreeKiTyVars
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsTypeArg GhcPs -> FreeKiTyVars -> FreeKiTyVars
HsArg
  GhcPs
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> FreeKiTyVars -> FreeKiTyVars
extract_tyarg FreeKiTyVars
acc [LHsTypeArg GhcPs]
[HsArg
   GhcPs
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
args

extractHsTyArgRdrKiTyVars :: [LHsTypeArg GhcPs] -> FreeKiTyVars
extractHsTyArgRdrKiTyVars :: [LHsTypeArg GhcPs] -> FreeKiTyVars
extractHsTyArgRdrKiTyVars [LHsTypeArg GhcPs]
args
  = [LHsTypeArg GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_tyargs [LHsTypeArg GhcPs]
args []

-- | 'extractHsTyRdrTyVars' finds the type/kind variables
--                          of a HsType/HsKind.
-- It's used when making the @forall@s explicit.
-- See Note [Kind and type-variable binders]
extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
ty = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty []

-- | Extracts the free type/kind variables from the kind signature of a HsType.
--   This is used to implicitly quantify over @k@ in @type T = Nothing :: Maybe k@.
-- The left-to-right order of variables is preserved.
-- See Note [Kind and type-variable binders] and
--     Note [Ordering of implicit variables] and
--     Note [Implicit quantification in type synonyms].
extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVarsKindVars (L SrcSpanAnnA
_ HsType GhcPs
ty) =
  case HsType GhcPs
ty of
    HsParTy XParTy GhcPs
_ LHsType GhcPs
ty -> LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVarsKindVars LHsType GhcPs
ty
    HsKindSig XKindSig GhcPs
_ LHsType GhcPs
_ LHsType GhcPs
ki -> LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
ki
    HsType GhcPs
_ -> []

-- | Extracts free type and kind variables from types in a list.
-- When the same name occurs multiple times in the types, all occurrences
-- are returned.
extractHsTysRdrTyVars :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extractHsTysRdrTyVars :: HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extractHsTysRdrTyVars HsContext GhcPs
tys = HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys HsContext GhcPs
tys

-- Returns the free kind variables of any explicitly-kinded binders, returning
-- variable occurrences in left-to-right order.
-- See Note [Ordering of implicit variables].
-- NB: Does /not/ delete the binders themselves.
--     E.g. given  [k1, a:k1, b:k2]
--          the function returns [k1,k2], even though k1 is bound here
extractHsTyVarBndrsKVs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
extractHsTyVarBndrsKVs :: forall flag. [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
extractHsTyVarBndrsKVs [LHsTyVarBndr flag GhcPs]
tv_bndrs = [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
forall flag. [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
extract_hs_tv_bndrs_kvs [LHsTyVarBndr flag GhcPs]
tv_bndrs

-- Returns the free kind variables in a type family result signature, returning
-- variable occurrences in left-to-right order.
-- See Note [Ordering of implicit variables].
extractRdrKindSigVars :: LFamilyResultSig GhcPs -> FreeKiTyVars
extractRdrKindSigVars :: LFamilyResultSig GhcPs -> FreeKiTyVars
extractRdrKindSigVars (L EpAnnCO
_ FamilyResultSig GhcPs
resultSig) = case FamilyResultSig GhcPs
resultSig of
  KindSig XCKindSig GhcPs
_ LHsType GhcPs
k -> LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
k
  TyVarSig XTyVarSig GhcPs
_ (L SrcSpanAnnA
_ HsTyVarBndr () GhcPs
tvb) | HsTvb { tvb_kind :: forall flag pass. HsTyVarBndr flag pass -> HsBndrKind pass
tvb_kind = HsBndrKind XBndrKind GhcPs
_ LHsType GhcPs
k } <- HsTyVarBndr () GhcPs
tvb
    -> LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
k
  FamilyResultSig GhcPs
_ -> []

-- | Extracts free type and kind variables from an argument in a GADT
-- constructor, returning variable occurrences in left-to-right order.
-- See @Note [Ordering of implicit variables]@.
extractConDeclGADTDetailsTyVars ::
  HsConDeclGADTDetails GhcPs -> FreeKiTyVars -> FreeKiTyVars
extractConDeclGADTDetailsTyVars :: HsConDeclGADTDetails GhcPs -> FreeKiTyVars -> FreeKiTyVars
extractConDeclGADTDetailsTyVars HsConDeclGADTDetails GhcPs
con_args = case HsConDeclGADTDetails GhcPs
con_args of
  PrefixConGADT XPrefixConGADT GhcPs
_ [HsConDeclField GhcPs]
args    -> [HsConDeclField GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_scaled_ltys [HsConDeclField GhcPs]
args
  RecConGADT XRecConGADT GhcPs
_ (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)]
flds) -> [HsConDeclField GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_scaled_ltys ([HsConDeclField GhcPs] -> FreeKiTyVars -> FreeKiTyVars)
-> [HsConDeclField GhcPs] -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)
 -> HsConDeclField GhcPs)
-> [GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)]
-> [HsConDeclField GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (HsConDeclRecField GhcPs -> HsConDeclField GhcPs
forall pass. HsConDeclRecField pass -> HsConDeclField pass
cdrf_spec (HsConDeclRecField GhcPs -> HsConDeclField GhcPs)
-> (GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)
    -> HsConDeclRecField GhcPs)
-> GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)
-> HsConDeclField GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)
-> HsConDeclRecField GhcPs
forall l e. GenLocated l e -> e
unLoc) ([GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)]
 -> [HsConDeclField GhcPs])
-> [GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)]
-> [HsConDeclField GhcPs]
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsConDeclRecField GhcPs)]
flds

-- | Get type/kind variables mentioned in the kind signature, preserving
-- left-to-right order:
--
--  * data T a (b :: k1) :: k2 -> k1 -> k2 -> Type   -- result: [k2,k1]
--  * data T a (b :: k1)                             -- result: []
--
-- See Note [Ordering of implicit variables].
extractDataDefnKindVars :: HsDataDefn GhcPs ->  FreeKiTyVars
extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVars
extractDataDefnKindVars (HsDataDefn { dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (LHsType GhcPs)
ksig })
  = FreeKiTyVars
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> FreeKiTyVars)
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
-> FreeKiTyVars
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] LHsType GhcPs -> FreeKiTyVars
GenLocated SrcSpanAnnA (HsType GhcPs) -> FreeKiTyVars
extractHsTyRdrTyVars Maybe (LHsType GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
ksig

extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lctxt LHsContext GhcPs
ctxt = HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. GenLocated l e -> e
unLoc LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxt)

extract_scaled_ltys :: [HsConDeclField GhcPs]
                    -> FreeKiTyVars -> FreeKiTyVars
extract_scaled_ltys :: [HsConDeclField GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_scaled_ltys [HsConDeclField GhcPs]
args FreeKiTyVars
acc = (HsConDeclField GhcPs -> FreeKiTyVars -> FreeKiTyVars)
-> FreeKiTyVars -> [HsConDeclField GhcPs] -> FreeKiTyVars
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HsConDeclField GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_scaled_lty FreeKiTyVars
acc [HsConDeclField GhcPs]
args

extract_scaled_lty :: HsConDeclField GhcPs
                   -> FreeKiTyVars -> FreeKiTyVars
extract_scaled_lty :: HsConDeclField GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_scaled_lty (CDF { HsModifiedFunArr GhcPs
cdf_multiplicity :: forall pass. HsConDeclField pass -> HsModifiedFunArr pass
cdf_multiplicity :: HsModifiedFunArr GhcPs
cdf_multiplicity, LHsType GhcPs
cdf_type :: forall pass. HsConDeclField pass -> LHsType pass
cdf_type :: LHsType GhcPs
cdf_type }) FreeKiTyVars
acc
  = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
cdf_type (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ HsModifiedFunArr GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_hs_modified_fun_arr HsModifiedFunArr GhcPs
cdf_multiplicity FreeKiTyVars
acc

extract_ltys :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_ltys :: HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys HsContext GhcPs
tys FreeKiTyVars
acc = (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> FreeKiTyVars -> FreeKiTyVars)
-> FreeKiTyVars
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> FreeKiTyVars
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
GenLocated SrcSpanAnnA (HsType GhcPs)
-> FreeKiTyVars -> FreeKiTyVars
extract_lty FreeKiTyVars
acc HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys

extract_lty :: LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty :: LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty (L SrcSpanAnnA
_ HsType GhcPs
ty) FreeKiTyVars
acc
  = case HsType GhcPs
ty of
      HsTyVar XTyVar GhcPs
_ PromotionFlag
_  LIdOccP GhcPs
ltv            -> GenLocated SrcSpanAnnN RdrName -> FreeKiTyVars -> FreeKiTyVars
extract_tv LIdOccP GhcPs
GenLocated SrcSpanAnnN RdrName
ltv FreeKiTyVars
acc
      HsAppTy XAppTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2           -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty1 (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty2 FreeKiTyVars
acc
      HsAppKindTy XAppKindTy GhcPs
_ LHsType GhcPs
ty LHsType GhcPs
k          -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
k FreeKiTyVars
acc
      HsListTy XListTy GhcPs
_ LHsType GhcPs
ty               -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty FreeKiTyVars
acc
      HsTupleTy XTupleTy GhcPs
_ HsTupleSort
_ HsContext GhcPs
tys           -> HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys HsContext GhcPs
tys FreeKiTyVars
acc
      HsSumTy XSumTy GhcPs
_ HsContext GhcPs
tys               -> HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys HsContext GhcPs
tys FreeKiTyVars
acc
      HsFunTy XFunTy GhcPs
_ HsModifiedFunArr GhcPs
m LHsType GhcPs
ty1 LHsType GhcPs
ty2         -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty1 (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
                                     HsModifiedFunArr GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_hs_modified_fun_arr HsModifiedFunArr GhcPs
m (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ -- See Note [Ordering of implicit variables]
                                     LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty2 FreeKiTyVars
acc
      HsIParamTy XIParamTy GhcPs
_ XRec GhcPs HsIPName
_ LHsType GhcPs
ty           -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty FreeKiTyVars
acc
      HsOpTy XOpTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
op LHsType GhcPs
ty2         -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty1 (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
op (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty2 FreeKiTyVars
acc
      HsParTy XParTy GhcPs
_ LHsType GhcPs
ty                -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty FreeKiTyVars
acc
      HsSpliceTy {}               -> FreeKiTyVars
acc  -- Type splices mention no tvs
      HsDocTy XDocTy GhcPs
_ LHsType GhcPs
ty LHsDoc GhcPs
_              -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty FreeKiTyVars
acc
      HsExplicitListTy XExplicitListTy GhcPs
_ PromotionFlag
_ HsContext GhcPs
tys    -> HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys HsContext GhcPs
tys FreeKiTyVars
acc
      HsExplicitTupleTy XExplicitTupleTy GhcPs
_ PromotionFlag
_ HsContext GhcPs
tys   -> HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys HsContext GhcPs
tys FreeKiTyVars
acc
      HsTyLit XTyLit GhcPs
_ HsLit GhcPs
_                 -> FreeKiTyVars
acc
      HsStarTy XStarTy GhcPs
_                  -> FreeKiTyVars
acc
      HsKindSig XKindSig GhcPs
_ LHsType GhcPs
ty LHsType GhcPs
ki           -> LHsType GhcPs -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_kind_sig LHsType GhcPs
ty LHsType GhcPs
ki FreeKiTyVars
acc
      HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllTelescope GhcPs
tele, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
ty }
                                  -> HsForAllTelescope GhcPs
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
extract_hs_for_all_telescope HsForAllTelescope GhcPs
tele FreeKiTyVars
acc (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty []
      HsQualTy { hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_ctxt = LHsContext GhcPs
ctxt, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
ty }
                                  -> LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lctxt LHsContext GhcPs
ctxt (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty FreeKiTyVars
acc
      XHsType {}                  -> FreeKiTyVars
acc
      -- We deal with these separately in rnLHsTypeWithWildCards
      HsWildCardTy {}             -> FreeKiTyVars
acc

extract_kind_sig :: LHsType GhcPs -- type
                 -> LHsType GhcPs -- kind
                 -> FreeKiTyVars -> FreeKiTyVars
extract_kind_sig :: LHsType GhcPs -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_kind_sig LHsType GhcPs
ty LHsType GhcPs
ki FreeKiTyVars
acc
  | (L SrcSpanAnnA
_ HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllInvis { hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity GhcPs]
bndrs }
                    , hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
ki_body }) <- LHsType GhcPs
ki
  = [LHsTyVarBndr Specificity GhcPs]
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
forall flag.
[LHsTyVarBndr flag GhcPs]
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
extract_hs_tv_bndrs [LHsTyVarBndr Specificity GhcPs]
bndrs FreeKiTyVars
acc (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
    LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
    LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ki_body []
extract_kind_sig LHsType GhcPs
ty LHsType GhcPs
ki FreeKiTyVars
acc
  = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
    LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ki FreeKiTyVars
acc

extract_lhs_sig_ty :: LHsSigType GhcPs -> FreeKiTyVars
extract_lhs_sig_ty :: LHsSigType GhcPs -> FreeKiTyVars
extract_lhs_sig_ty (L SrcSpanAnnA
_ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcPs
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType GhcPs
body})) =
  HsOuterSigTyVarBndrs GhcPs -> FreeKiTyVars -> FreeKiTyVars
forall flag.
HsOuterTyVarBndrs flag GhcPs -> FreeKiTyVars -> FreeKiTyVars
extractHsOuterTvBndrs HsOuterSigTyVarBndrs GhcPs
outer_bndrs (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
body []

extract_hs_modifier :: LHsModifier GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_hs_modifier :: LHsModifier GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_hs_modifier (L SrcSpanAnnA
_ (HsModifier XModifier GhcPs
_ GenLocated SrcSpanAnnA (HsType GhcPs)
ty)) FreeKiTyVars
acc = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty FreeKiTyVars
acc

extract_hs_modifiers :: [LHsModifier GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_hs_modifiers :: [LHsModifier GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_hs_modifiers [LHsModifier GhcPs]
mods FreeKiTyVars
acc = (GenLocated
   SrcSpanAnnA
   (HsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)
 -> FreeKiTyVars -> FreeKiTyVars)
-> FreeKiTyVars
-> [GenLocated
      SrcSpanAnnA
      (HsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)]
-> FreeKiTyVars
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsModifier GhcPs -> FreeKiTyVars -> FreeKiTyVars
GenLocated
  SrcSpanAnnA
  (HsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)
-> FreeKiTyVars -> FreeKiTyVars
extract_hs_modifier FreeKiTyVars
acc [LHsModifier GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsModifierOf (GenLocated SrcSpanAnnA (HsType GhcPs)) GhcPs)]
mods

extract_hs_modified_fun_arr :: HsModifiedFunArr GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_hs_modified_fun_arr :: HsModifiedFunArr GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_hs_modified_fun_arr (HsModifiedFunArr XHsModifiedFunArr (LHsType (NoGhcTc GhcPs)) GhcPs
_ [LHsModifier GhcPs]
mods HsFunArr GhcPs
_) = [LHsModifier GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_hs_modifiers [LHsModifier GhcPs]
mods

extract_hs_for_all_telescope :: HsForAllTelescope GhcPs
                             -> FreeKiTyVars -- Accumulator
                             -> FreeKiTyVars -- Free in body
                             -> FreeKiTyVars
extract_hs_for_all_telescope :: HsForAllTelescope GhcPs
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
extract_hs_for_all_telescope HsForAllTelescope GhcPs
tele FreeKiTyVars
acc_vars FreeKiTyVars
body_fvs =
  case HsForAllTelescope GhcPs
tele of
    HsForAllVis { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () GhcPs]
bndrs } ->
      [LHsTyVarBndr () GhcPs]
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
forall flag.
[LHsTyVarBndr flag GhcPs]
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
extract_hs_tv_bndrs [LHsTyVarBndr () GhcPs]
bndrs FreeKiTyVars
acc_vars FreeKiTyVars
body_fvs
    HsForAllInvis { hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity GhcPs]
bndrs } ->
      [LHsTyVarBndr Specificity GhcPs]
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
forall flag.
[LHsTyVarBndr flag GhcPs]
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
extract_hs_tv_bndrs [LHsTyVarBndr Specificity GhcPs]
bndrs FreeKiTyVars
acc_vars FreeKiTyVars
body_fvs

extractHsOuterTvBndrs :: HsOuterTyVarBndrs flag GhcPs
                      -> FreeKiTyVars -- Free in body
                      -> FreeKiTyVars -- Free in result
extractHsOuterTvBndrs :: forall flag.
HsOuterTyVarBndrs flag GhcPs -> FreeKiTyVars -> FreeKiTyVars
extractHsOuterTvBndrs HsOuterTyVarBndrs flag GhcPs
outer_bndrs FreeKiTyVars
body_fvs =
  case HsOuterTyVarBndrs flag GhcPs
outer_bndrs of
    HsOuterImplicit{}                  -> FreeKiTyVars
body_fvs
    HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr flag (NoGhcTc GhcPs)]
bndrs} -> [LHsTyVarBndr flag GhcPs]
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
forall flag.
[LHsTyVarBndr flag GhcPs]
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
extract_hs_tv_bndrs [LHsTyVarBndr flag (NoGhcTc GhcPs)]
[LHsTyVarBndr flag GhcPs]
bndrs [] FreeKiTyVars
body_fvs

extractHsForAllTelescopes :: [HsForAllTelescope GhcPs]
                          -> FreeKiTyVars -- Free in body
                          -> FreeKiTyVars -- Free in result
extractHsForAllTelescopes :: [HsForAllTelescope GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extractHsForAllTelescopes []           FreeKiTyVars
body_fvs = FreeKiTyVars
body_fvs
extractHsForAllTelescopes (HsForAllTelescope GhcPs
tele:[HsForAllTelescope GhcPs]
teles) FreeKiTyVars
body_fvs =
  HsForAllTelescope GhcPs
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
extract_hs_for_all_telescope HsForAllTelescope GhcPs
tele [] (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
  [HsForAllTelescope GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extractHsForAllTelescopes [HsForAllTelescope GhcPs]
teles FreeKiTyVars
body_fvs

extract_hs_tv_bndrs :: [LHsTyVarBndr flag GhcPs]
                    -> FreeKiTyVars  -- Accumulator
                    -> FreeKiTyVars  -- Free in body
                    -> FreeKiTyVars
-- In (forall (a :: Maybe e). a -> b) we have
--     'a' is bound by the forall
--     'b' is a free type variable
--     'e' is a free kind variable
extract_hs_tv_bndrs :: forall flag.
[LHsTyVarBndr flag GhcPs]
-> FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
extract_hs_tv_bndrs [LHsTyVarBndr flag GhcPs]
tv_bndrs FreeKiTyVars
acc_vars FreeKiTyVars
body_vars = FreeKiTyVars
new_vars FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
forall a. [a] -> [a] -> [a]
++ FreeKiTyVars
acc_vars
  where
    new_vars :: FreeKiTyVars
new_vars
      | [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr flag GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
tv_bndrs = FreeKiTyVars
body_vars
      | Bool
otherwise = FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
filterFreeNamesToBind FreeKiTyVars
tv_bndr_rdrs (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ FreeKiTyVars
bndr_vars FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
forall a. [a] -> [a] -> [a]
++ FreeKiTyVars
body_vars
    -- NB: delete all tv_bndr_rdrs from bndr_vars as well as body_vars.
    -- See Note [Kind variable scoping]
    bndr_vars :: FreeKiTyVars
bndr_vars = [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
forall flag. [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
extract_hs_tv_bndrs_kvs [LHsTyVarBndr flag GhcPs]
tv_bndrs
    tv_bndr_rdrs :: FreeKiTyVars
tv_bndr_rdrs = (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
 -> Maybe (GenLocated SrcSpanAnnN RdrName))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
-> FreeKiTyVars
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LHsTyVarBndr flag GhcPs -> Maybe (LocatedN (IdP GhcPs))
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> Maybe (GenLocated SrcSpanAnnN RdrName)
forall (p :: Pass) flag.
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
LHsTyVarBndr flag (GhcPass p) -> Maybe (LocatedN (IdP (GhcPass p)))
hsLTyVarLocName [LHsTyVarBndr flag GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
tv_bndrs

extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
-- Returns the free kind variables of any explicitly-kinded binders, returning
-- variable occurrences in left-to-right order.
-- See Note [Ordering of implicit variables].
-- NB: Does /not/ delete the binders themselves.
--     E.g. given  [k1, a:k1, b:k2]
--          the function returns [k1,k2], even though k1 is bound here
extract_hs_tv_bndrs_kvs :: forall flag. [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
extract_hs_tv_bndrs_kvs [LHsTyVarBndr flag GhcPs]
tv_bndrs =
    (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> FreeKiTyVars -> FreeKiTyVars)
-> FreeKiTyVars
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> FreeKiTyVars
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
GenLocated SrcSpanAnnA (HsType GhcPs)
-> FreeKiTyVars -> FreeKiTyVars
extract_lty []
          [LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
k | L SrcSpanAnnA
_ (HsTvb { tvb_kind :: forall flag pass. HsTyVarBndr flag pass -> HsBndrKind pass
tvb_kind = HsBndrKind XBndrKind GhcPs
_ LHsType GhcPs
k }) <- [LHsTyVarBndr flag GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
tv_bndrs]

extract_tv :: LocatedN RdrName -> FreeKiTyVars -> FreeKiTyVars
extract_tv :: GenLocated SrcSpanAnnN RdrName -> FreeKiTyVars -> FreeKiTyVars
extract_tv GenLocated SrcSpanAnnN RdrName
tv FreeKiTyVars
acc =
  if RdrName -> Bool
isRdrTyVar (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
tv) Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (RdrName -> Bool) -> RdrName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> Bool
isQual) (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
tv) then GenLocated SrcSpanAnnN RdrName
tvGenLocated SrcSpanAnnN RdrName -> FreeKiTyVars -> FreeKiTyVars
forall a. a -> [a] -> [a]
:FreeKiTyVars
acc else FreeKiTyVars
acc

-- Deletes duplicates in a list of Located things. This is used to:
--
-- * Delete duplicate occurrences of implicitly bound type/kind variables when
--   bringing them into scope (in rnImplicitTvOccs).
--
-- * Delete duplicate occurrences of named wildcards (in rn_hs_sig_wc_type and
--   rnHsWcType).
--
-- Importantly, this function is stable with respect to the original ordering
-- of things in the list. This is important, as it is a property that GHC
-- relies on to maintain the left-to-right ordering of implicitly quantified
-- type variables.
-- See Note [Ordering of implicit variables].
nubL :: Eq a => [GenLocated l a] -> [GenLocated l a]
nubL :: forall a l. Eq a => [GenLocated l a] -> [GenLocated l a]
nubL = (GenLocated l a -> GenLocated l a -> Bool)
-> [GenLocated l a] -> [GenLocated l a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy GenLocated l a -> GenLocated l a -> Bool
forall a l. Eq a => GenLocated l a -> GenLocated l a -> Bool
eqLocated

nubN :: Eq a => [LocatedN a] -> [LocatedN a]
nubN :: forall a. Eq a => [LocatedN a] -> [LocatedN a]
nubN = (LocatedN a -> LocatedN a -> Bool) -> [LocatedN a] -> [LocatedN a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy LocatedN a -> LocatedN a -> Bool
forall a l. Eq a => GenLocated l a -> GenLocated l a -> Bool
eqLocated

-- | Filter out any potential implicit binders that are either
-- already in scope, or are explicitly bound in the binder.
filterFreeNamesToBind :: FreeKiTyVars
                     -- ^ Explicitly bound here
                     -> FreeKiTyVars
                     -- ^ Potential implicit binders
                     -> FreeKiTyVars
                     -- ^ Final implicit binders
filterFreeNamesToBind :: FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
filterFreeNamesToBind FreeKiTyVars
bndrs = (GenLocated SrcSpanAnnN RdrName -> Bool)
-> FreeKiTyVars -> FreeKiTyVars
forall a. (a -> Bool) -> [a] -> [a]
filterOut GenLocated SrcSpanAnnN RdrName -> Bool
is_in_scope
    -- Make sure to list the binder kvs before the body kvs, as mandated by
    -- Note [Ordering of implicit variables]
  where
    is_in_scope :: GenLocated SrcSpanAnnN RdrName -> Bool
is_in_scope GenLocated SrcSpanAnnN RdrName
locc = (GenLocated SrcSpanAnnN RdrName -> Bool) -> FreeKiTyVars -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN RdrName -> Bool
forall a l. Eq a => GenLocated l a -> GenLocated l a -> Bool
eqLocated GenLocated SrcSpanAnnN RdrName
locc) FreeKiTyVars
bndrs