{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
module GHC.Rename.HsType (
        
        rnHsType, rnLHsType, rnLHsTypes, rnContext, rnMaybeContext,
        rnHsKind, rnLHsKind, rnLHsTypeArgs,
        rnHsSigType, rnHsWcType, rnHsPatSigTypeBindingVars,
        HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType,
        newTyVarNameRn,
        rnConDeclFields,
        lookupField,
        rnLTyVar,
        rnScaledLHsType,
        
        NegationHandling(..),
        mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
        checkPrecMatch, checkSectionPrec,
        
        bindHsOuterTyVarBndrs, bindHsForAllTelescope,
        bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..),
        rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars,
        FreeKiTyVars, filterInScopeM,
        extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
        extractHsTysRdrTyVars, extractRdrKindSigVars,
        extractConDeclGADTDetailsTyVars, extractDataDefnKindVars,
        extractHsOuterTvBndrs, extractHsTyArgRdrKiTyVars,
        nubL, nubN
  ) where
import GHC.Prelude
import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType )
import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList )
import GHC.Driver.Session
import GHC.Hs
import GHC.Rename.Env
import GHC.Rename.Doc
import GHC.Rename.Utils  ( mapFvRn, bindLocalNamesFV
                         , typeAppErr, newLocalBndrRn, checkDupRdrNamesN
                         , checkShadowedRdrNames, warnForallIdentifier )
import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn
                         , lookupTyFixityRn )
import GHC.Rename.Unbound ( notInScopeErr, WhereLooking(WL_LocalOnly) )
import GHC.Tc.Errors.Types
import GHC.Tc.Errors.Ppr ( pprScopeError
                         , inHsDocContext, withHsDocContext, pprHsDocContext )
import GHC.Tc.Utils.Monad
import GHC.Types.Name.Reader
import GHC.Builtin.Names
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.Error
import GHC.Utils.Misc
import GHC.Types.Fixity ( compareFixity, negateFixity
                        , Fixity(..), FixityDirection(..), LexicalFixity(..) )
import GHC.Types.Basic  ( PromotionFlag(..), isPromoted, TypeOrKind(..) )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Data.Maybe
import qualified GHC.LanguageExtensions as LangExt
import Data.List (sortBy, nubBy, partition)
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty(..))
import Control.Monad
data HsPatSigTypeScoping
  = AlwaysBind
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
  | NeverBind
    
    
    
    
    
    
    
    
    
    
    
    
rnHsSigWcType :: HsDocContext
              -> LHsSigWcType GhcPs
              -> RnM (LHsSigWcType GhcRn, FreeVars)
rnHsSigWcType :: HsDocContext
-> LHsSigWcType GhcPs -> RnM (LHsSigWcType GhcRn, FreeVars)
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 { FreeKiTyVars
free_vars <- FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM (LHsSigType GhcPs -> FreeKiTyVars
extract_lhs_sig_ty LHsSigType GhcPs
sig_ty)
       ; (FreeKiTyVars
nwc_rdrs', FreeKiTyVars
imp_tv_nms) <- FreeKiTyVars -> RnM (FreeKiTyVars, FreeKiTyVars)
partition_nwcs FreeKiTyVars
free_vars
       ; let nwc_rdrs :: FreeKiTyVars
nwc_rdrs = FreeKiTyVars -> FreeKiTyVars
forall a l. Eq a => [GenLocated l a] -> [GenLocated l a]
nubL FreeKiTyVars
nwc_rdrs'
       ; HsDocContext
-> Maybe Any
-> FreeKiTyVars
-> HsOuterSigTyVarBndrs GhcPs
-> (HsOuterTyVarBndrs Specificity GhcRn
    -> RnM
         (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn)),
          FreeVars))
-> RnM
     (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn)),
      FreeVars)
forall flag assoc a.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> Maybe assoc
-> FreeKiTyVars
-> HsOuterTyVarBndrs flag GhcPs
-> (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
bindHsOuterTyVarBndrs HsDocContext
doc Maybe Any
forall a. Maybe a
Nothing FreeKiTyVars
imp_tv_nms HsOuterSigTyVarBndrs GhcPs
outer_bndrs ((HsOuterTyVarBndrs Specificity GhcRn
  -> RnM
       (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn)),
        FreeVars))
 -> RnM
      (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn)),
       FreeVars))
-> (HsOuterTyVarBndrs Specificity GhcRn
    -> RnM
         (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn)),
          FreeVars))
-> RnM
     (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn)),
      FreeVars)
forall a b. (a -> b) -> a -> b
$ \HsOuterTyVarBndrs Specificity GhcRn
outer_bndrs' ->
    do { ([Name]
wcs, GenLocated SrcSpanAnnA (HsType GhcRn)
body_ty', FreeVars
fvs) <- HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody HsDocContext
doc FreeKiTyVars
nwc_rdrs LHsType GhcPs
body_ty
       ; (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn)),
 FreeVars)
-> RnM
     (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn)),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( HsWC  { hswc_ext :: XHsWC GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
hswc_ext = [Name]
XHsWC GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
wcs, hswc_body :: GenLocated SrcSpanAnnA (HsSigType GhcRn)
hswc_body = SrcSpanAnnA
-> HsSigType GhcRn -> GenLocated SrcSpanAnnA (HsSigType GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsSigType GhcRn -> GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> HsSigType GhcRn -> GenLocated SrcSpanAnnA (HsSigType GhcRn)
forall a b. (a -> b) -> a -> b
$
                HsSig { sig_ext :: XHsSig GhcRn
sig_ext = XHsSig GhcRn
NoExtField
noExtField
                      , sig_bndrs :: HsOuterTyVarBndrs Specificity GhcRn
sig_bndrs = HsOuterTyVarBndrs Specificity GhcRn
outer_bndrs', sig_body :: LHsType GhcRn
sig_body = LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
body_ty' }}
              , FreeVars
fvs) } }
rnHsPatSigType :: HsPatSigTypeScoping
               -> HsDocContext
               -> HsPatSigType GhcPs
               -> (HsPatSigType GhcRn -> RnM (a, FreeVars))
               -> RnM (a, FreeVars)
rnHsPatSigType :: forall a.
HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnHsPatSigType HsPatSigTypeScoping
scoping HsDocContext
ctx HsPatSigType GhcPs
sig_ty HsPatSigType GhcRn -> RnM (a, FreeVars)
thing_inside
  = do { Bool
ty_sig_okay <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.ScopedTypeVariables
       ; Bool -> TcRnMessage -> TcRn ()
checkErr Bool
ty_sig_okay (HsPatSigType GhcPs -> TcRnMessage
unexpectedPatSigTypeErr HsPatSigType GhcPs
sig_ty)
       ; FreeKiTyVars
free_vars <- FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM (LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
pat_sig_ty)
       ; (FreeKiTyVars
nwc_rdrs', FreeKiTyVars
tv_rdrs) <- FreeKiTyVars -> RnM (FreeKiTyVars, FreeKiTyVars)
partition_nwcs FreeKiTyVars
free_vars
       ; let nwc_rdrs :: FreeKiTyVars
nwc_rdrs = FreeKiTyVars -> FreeKiTyVars
forall a. Eq a => [LocatedN a] -> [LocatedN a]
nubN FreeKiTyVars
nwc_rdrs'
             implicit_bndrs :: FreeKiTyVars
implicit_bndrs = case HsPatSigTypeScoping
scoping of
               HsPatSigTypeScoping
AlwaysBind -> FreeKiTyVars
tv_rdrs
               HsPatSigTypeScoping
NeverBind  -> []
       ; Maybe Any
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall assoc a.
Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnImplicitTvOccs Maybe Any
forall a. Maybe a
Nothing FreeKiTyVars
implicit_bndrs (([Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars))
-> ([Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
imp_tvs ->
    do { ([Name]
nwcs, GenLocated SrcSpanAnnA (HsType GhcRn)
pat_sig_ty', FreeVars
fvs1) <- HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody HsDocContext
ctx FreeKiTyVars
nwc_rdrs LHsType GhcPs
pat_sig_ty
       ; let sig_names :: HsPSRn
sig_names = HsPSRn { hsps_nwcs :: [Name]
hsps_nwcs = [Name]
nwcs, hsps_imp_tvs :: [Name]
hsps_imp_tvs = [Name]
imp_tvs }
             sig_ty' :: HsPatSigType GhcRn
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' }
       ; (a
res, FreeVars
fvs2) <- HsPatSigType GhcRn -> RnM (a, FreeVars)
thing_inside HsPatSigType GhcRn
sig_ty'
       ; (a, FreeVars) -> RnM (a, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
res, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) } }
  where
    pat_sig_ty :: LHsType GhcPs
pat_sig_ty = HsPatSigType GhcPs -> LHsType GhcPs
forall pass. HsPatSigType pass -> LHsType pass
hsPatSigType HsPatSigType GhcPs
sig_ty
rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
rnHsWcType HsDocContext
ctxt (HsWC { hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = LHsType GhcPs
hs_ty })
  = do { FreeKiTyVars
free_vars <- FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM (LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
hs_ty)
       ; (FreeKiTyVars
nwc_rdrs', FreeKiTyVars
_) <- FreeKiTyVars -> RnM (FreeKiTyVars, FreeKiTyVars)
partition_nwcs FreeKiTyVars
free_vars
       ; let nwc_rdrs :: FreeKiTyVars
nwc_rdrs = FreeKiTyVars -> FreeKiTyVars
forall a l. Eq a => [GenLocated l a] -> [GenLocated l a]
nubL FreeKiTyVars
nwc_rdrs'
       ; ([Name]
wcs, GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty', FreeVars
fvs) <- HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody HsDocContext
ctxt FreeKiTyVars
nwc_rdrs LHsType GhcPs
hs_ty
       ; let sig_ty' :: HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
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' }
       ; (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
sig_ty', FreeVars
fvs) }
rnHsPatSigTypeBindingVars :: HsDocContext
                          -> HsPatSigType GhcPs
                          -> (HsPatSigType GhcRn -> RnM (r, FreeVars))
                          -> RnM (r, FreeVars)
rnHsPatSigTypeBindingVars :: forall r.
HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType GhcRn -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
rnHsPatSigTypeBindingVars HsDocContext
ctxt HsPatSigType GhcPs
sigType HsPatSigType GhcRn -> RnM (r, FreeVars)
thing_inside = case HsPatSigType GhcPs
sigType of
  (HsPS { hsps_body :: forall pass. HsPatSigType pass -> LHsType pass
hsps_body = LHsType GhcPs
hs_ty }) -> do
    LocalRdrEnv
rdr_env <- RnM LocalRdrEnv
getLocalRdrEnv
    let (FreeKiTyVars
varsInScope, FreeKiTyVars
varsNotInScope) =
          (GenLocated SrcSpanAnnN RdrName -> Bool)
-> FreeKiTyVars -> (FreeKiTyVars, FreeKiTyVars)
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (LocalRdrEnv -> RdrName -> Bool
inScope LocalRdrEnv
rdr_env (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) (LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
hs_ty)
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (FreeKiTyVars -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FreeKiTyVars
varsInScope)) (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
$ DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
vcat
          [ String -> SDoc
text String
"Type variable" SDoc -> SDoc -> SDoc
<> FreeKiTyVars -> SDoc
forall a. [a] -> SDoc
plural FreeKiTyVars
varsInScope
            SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hcat (SDoc -> [SDoc] -> [SDoc]
punctuate (String -> SDoc
text String
",") ((GenLocated SrcSpanAnnN RdrName -> SDoc) -> FreeKiTyVars -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotes (SDoc -> SDoc)
-> (GenLocated SrcSpanAnnN RdrName -> SDoc)
-> GenLocated SrcSpanAnnN RdrName
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr) FreeKiTyVars
varsInScope))
            SDoc -> SDoc -> SDoc
<+> FreeKiTyVars -> SDoc
forall a. [a] -> SDoc
isOrAre FreeKiTyVars
varsInScope
            SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"already in scope."
          , String -> SDoc
text String
"Type applications in patterns must bind fresh variables, without shadowing."
          ]
    (FreeKiTyVars
wcVars, FreeKiTyVars
ibVars) <- FreeKiTyVars -> RnM (FreeKiTyVars, FreeKiTyVars)
partition_nwcs FreeKiTyVars
varsNotInScope
    HsDocContext
-> Maybe Any
-> FreeKiTyVars
-> ([Name] -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
forall assoc a.
HsDocContext
-> Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnImplicitTvBndrs HsDocContext
ctxt Maybe Any
forall a. Maybe a
Nothing FreeKiTyVars
ibVars (([Name] -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> ([Name] -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
ibVars' -> do
      ([Name]
wcVars', GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty', FreeVars
fvs) <- HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody HsDocContext
ctxt FreeKiTyVars
wcVars LHsType GhcPs
hs_ty
      let sig_ty :: HsPatSigType GhcRn
sig_ty = HsPS
            { hsps_body :: LHsType GhcRn
hsps_body = LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty'
            , hsps_ext :: XHsPS GhcRn
hsps_ext = HsPSRn
              { hsps_nwcs :: [Name]
hsps_nwcs    = [Name]
wcVars'
              , hsps_imp_tvs :: [Name]
hsps_imp_tvs = [Name]
ibVars'
              }
            }
      (r
res, FreeVars
fvs') <- HsPatSigType GhcRn -> RnM (r, FreeVars)
thing_inside HsPatSigType GhcRn
sig_ty
      (r, FreeVars) -> RnM (r, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (r
res, FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs')
rnWcBody :: HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs
         -> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody :: HsDocContext
-> FreeKiTyVars
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody HsDocContext
ctxt FreeKiTyVars
nwc_rdrs LHsType GhcPs
hs_ty
  = do { [Name]
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 :: RnTyKiEnv
env = RTKE { rtke_level :: TypeOrKind
rtke_level = TypeOrKind
TypeLevel
                        , rtke_what :: RnTyKiWhat
rtke_what  = RnTyKiWhat
RnTypeBody
                        , rtke_nwcs :: FreeVars
rtke_nwcs  = [Name] -> FreeVars
mkNameSet [Name]
nwcs
                        , rtke_ctxt :: HsDocContext
rtke_ctxt  = HsDocContext
ctxt }
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty', FreeVars
fvs) <- [Name]
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name]
nwcs (RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars))
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
forall a b. (a -> b) -> a -> b
$
                          RnTyKiEnv
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
forall {ann}.
RnTyKiEnv
-> GenLocated (SrcSpanAnn' ann) (HsType GhcPs)
-> TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
rn_lty RnTyKiEnv
env LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hs_ty
       ; ([Name], GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([Name], GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name]
nwcs, GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty', FreeVars
fvs) }
  where
    rn_lty :: RnTyKiEnv
-> GenLocated (SrcSpanAnn' ann) (HsType GhcPs)
-> TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
rn_lty RnTyKiEnv
env (L SrcSpanAnn' ann
loc HsType GhcPs
hs_ty)
      = SrcSpanAnn' ann
-> TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
-> TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnn' ann
loc (TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
 -> TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars))
-> TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
-> TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
forall a b. (a -> b) -> a -> b
$
        do { (HsType GhcRn
hs_ty', FreeVars
fvs) <- RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rn_ty RnTyKiEnv
env HsType GhcPs
hs_ty
           ; (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
-> TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnn' ann
-> HsType GhcRn -> GenLocated (SrcSpanAnn' ann) (HsType GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' ann
loc HsType GhcRn
hs_ty', FreeVars
fvs) }
    rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
    
    rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
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, FreeVars))
-> RnM (HsType GhcRn, FreeVars)
forall a.
HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
bindHsForAllTelescope (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) HsForAllTelescope GhcPs
tele ((HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeVars))
 -> RnM (HsType GhcRn, FreeVars))
-> (HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeVars))
-> RnM (HsType GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ HsForAllTelescope GhcRn
tele' ->
        do { (GenLocated SrcSpanAnnA (HsType GhcRn)
hs_body', FreeVars
fvs) <- RnTyKiEnv
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
forall {ann}.
RnTyKiEnv
-> GenLocated (SrcSpanAnn' ann) (HsType GhcPs)
-> TcRn (GenLocated (SrcSpanAnn' ann) (HsType GhcRn), FreeVars)
rn_lty RnTyKiEnv
env LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hs_body
           ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsForAllTy { hst_xforall :: XForAllTy GhcRn
hst_xforall = XForAllTy GhcRn
NoExtField
noExtField
                                , hst_tele :: HsForAllTelescope GhcRn
hst_tele = HsForAllTelescope GhcRn
tele', hst_body :: LHsType GhcRn
hst_body = LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
hs_body' }
                    , FreeVars
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 { ([GenLocated SrcSpanAnnA (HsType GhcRn)]
hs_ctxt1', FreeVars
fvs1) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
rn_top_constraint RnTyKiEnv
env) [GenLocated SrcSpanAnnA (HsType GhcPs)]
hs_ctxt1
           ; SrcSpanAnnA -> TcRn () -> TcRn ()
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
lx (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ RnTyKiEnv -> HsContext GhcPs -> TcRn ()
checkExtraConstraintWildCard RnTyKiEnv
env HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
hs_ctxt1
           ; let hs_ctxt' :: [GenLocated SrcSpanAnnA (HsType GhcRn)]
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)]
           ; (GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty', FreeVars
fvs2) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
hs_ty
           ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsQualTy { hst_xqual :: XQualTy GhcRn
hst_xqual = XQualTy GhcRn
NoExtField
noExtField
                              , hst_ctxt :: LHsContext GhcRn
hst_ctxt = SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
cx [GenLocated SrcSpanAnnA (HsType GhcRn)]
hs_ctxt'
                              , hst_body :: LHsType GhcRn
hst_body = LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty' }
                    , FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }
      | Bool
otherwise
      = do { ([GenLocated SrcSpanAnnA (HsType GhcRn)]
hs_ctxt', FreeVars
fvs1) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
rn_top_constraint RnTyKiEnv
env) [GenLocated SrcSpanAnnA (HsType GhcPs)]
hs_ctxt
           ; (GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty', FreeVars
fvs2)   <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
hs_ty
           ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsQualTy { hst_xqual :: XQualTy GhcRn
hst_xqual = XQualTy GhcRn
NoExtField
noExtField
                              , hst_ctxt :: LHsContext GhcRn
hst_ctxt = SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
cx [GenLocated SrcSpanAnnA (HsType GhcRn)]
hs_ctxt'
                              , hst_body :: LHsType GhcRn
hst_body = LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
hs_ty' }
                    , FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }
    rn_ty RnTyKiEnv
env HsType GhcPs
hs_ty = RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rnHsTyKi RnTyKiEnv
env HsType GhcPs
hs_ty
    rn_top_constraint :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rn_top_constraint RnTyKiEnv
env = RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi (RnTyKiEnv
env { rtke_what :: RnTyKiWhat
rtke_what = RnTyKiWhat
RnTopConstraint })
checkExtraConstraintWildCard :: RnTyKiEnv -> HsContext GhcPs -> RnM ()
 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
forall a. a -> Maybe a
Just (BadAnonWildcardContext -> Maybe BadAnonWildcardContext)
-> BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a b. (a -> b) -> a -> b
$ SoleExtraConstraintWildcardAllowed -> BadAnonWildcardContext
ExtraConstraintWildcardNotAllowed
                      SoleExtraConstraintWildcardAllowed
SoleExtraConstraintWildcardNotAllowed
             
             
             
             
             
             
             
             
             
           | 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
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
 RnTyKiEnv
env
  = case RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env of
      TypeSigCtx {}       -> Bool
True
      ExprWithTySigCtx {} -> Bool
True
      DerivDeclCtx {}     -> Bool
True
      StandaloneKindSigCtx {} -> Bool
False  
      HsDocContext
_                   -> Bool
False
partition_nwcs :: FreeKiTyVars -> RnM ([LocatedN RdrName], FreeKiTyVars)
partition_nwcs :: FreeKiTyVars -> RnM (FreeKiTyVars, FreeKiTyVars)
partition_nwcs FreeKiTyVars
free_vars
  = do { Bool
wildcards_enabled <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.NamedWildCards
       ; (FreeKiTyVars, FreeKiTyVars) -> RnM (FreeKiTyVars, FreeKiTyVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((FreeKiTyVars, FreeKiTyVars) -> RnM (FreeKiTyVars, FreeKiTyVars))
-> (FreeKiTyVars, FreeKiTyVars) -> RnM (FreeKiTyVars, FreeKiTyVars)
forall a b. (a -> b) -> a -> b
$
           if Bool
wildcards_enabled
           then (GenLocated SrcSpanAnnN RdrName -> Bool)
-> FreeKiTyVars -> (FreeKiTyVars, FreeKiTyVars)
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition GenLocated SrcSpanAnnN RdrName -> Bool
is_wildcard FreeKiTyVars
free_vars
           else ([], FreeKiTyVars
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))
rnHsSigType :: HsDocContext
            -> TypeOrKind
            -> LHsSigType GhcPs
            -> RnM (LHsSigType GhcRn, FreeVars)
rnHsSigType :: HsDocContext
-> TypeOrKind
-> LHsSigType GhcPs
-> RnM (LHsSigType GhcRn, FreeVars)
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, FreeVars)
-> RnM (LHsSigType GhcRn, FreeVars)
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (RnM (LHsSigType GhcRn, FreeVars)
 -> RnM (LHsSigType GhcRn, FreeVars))
-> RnM (LHsSigType GhcRn, FreeVars)
-> RnM (LHsSigType GhcRn, FreeVars)
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 -> HsSigType GhcPs -> TcRn ()
forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
checkPolyKinds RnTyKiEnv
env HsSigType GhcPs
sig_ty
           HsOuterImplicit{} -> () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
       ; FreeKiTyVars
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
       ; HsDocContext
-> Maybe Any
-> FreeKiTyVars
-> HsOuterSigTyVarBndrs GhcPs
-> (HsOuterTyVarBndrs Specificity GhcRn
    -> RnM (GenLocated SrcSpanAnnA (HsSigType GhcRn), FreeVars))
-> RnM (GenLocated SrcSpanAnnA (HsSigType GhcRn), FreeVars)
forall flag assoc a.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> Maybe assoc
-> FreeKiTyVars
-> HsOuterTyVarBndrs flag GhcPs
-> (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
bindHsOuterTyVarBndrs HsDocContext
ctx Maybe Any
forall a. Maybe a
Nothing FreeKiTyVars
imp_vars HsOuterSigTyVarBndrs GhcPs
outer_bndrs ((HsOuterTyVarBndrs Specificity GhcRn
  -> RnM (GenLocated SrcSpanAnnA (HsSigType GhcRn), FreeVars))
 -> RnM (GenLocated SrcSpanAnnA (HsSigType GhcRn), FreeVars))
-> (HsOuterTyVarBndrs Specificity GhcRn
    -> RnM (GenLocated SrcSpanAnnA (HsSigType GhcRn), FreeVars))
-> RnM (GenLocated SrcSpanAnnA (HsSigType GhcRn), FreeVars)
forall a b. (a -> b) -> a -> b
$ \HsOuterTyVarBndrs Specificity GhcRn
outer_bndrs' ->
    do { (GenLocated SrcSpanAnnA (HsType GhcRn)
body', FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
body
       ; (GenLocated SrcSpanAnnA (HsSigType GhcRn), FreeVars)
-> RnM (GenLocated SrcSpanAnnA (HsSigType GhcRn), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( SrcSpanAnnA
-> HsSigType GhcRn -> GenLocated SrcSpanAnnA (HsSigType GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsSigType GhcRn -> GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> HsSigType GhcRn -> GenLocated SrcSpanAnnA (HsSigType GhcRn)
forall a b. (a -> b) -> a -> b
$ HsSig { sig_ext :: XHsSig GhcRn
sig_ext = XHsSig GhcRn
NoExtField
noExtField
                                , sig_bndrs :: HsOuterTyVarBndrs Specificity GhcRn
sig_bndrs = HsOuterTyVarBndrs Specificity GhcRn
outer_bndrs', sig_body :: LHsType GhcRn
sig_body = LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
body' }
                , FreeVars
fvs ) } }
  where
    env :: RnTyKiEnv
env = HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctx TypeOrKind
level RnTyKiWhat
RnTypeBody
rnImplicitTvOccs :: Maybe assoc
                 
                 -> FreeKiTyVars
                 
                 
                 -> ([Name] -> RnM (a, FreeVars))
                 -> RnM (a, FreeVars)
rnImplicitTvOccs :: forall assoc a.
Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnImplicitTvOccs Maybe assoc
mb_assoc FreeKiTyVars
implicit_vs_with_dups [Name] -> RnM (a, FreeVars)
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
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 ]
         
         
       ; SrcSpan
loc <- TcRn SrcSpan
getSrcSpanM
       ; let loc' :: SrcSpanAnnN
loc' = SrcSpan -> SrcSpanAnnN
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc
       ; [Name]
vars <- (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 (Maybe assoc
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a.
Maybe a
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn Maybe assoc
mb_assoc (GenLocated SrcSpanAnnN RdrName
 -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> (GenLocated SrcSpanAnnN RdrName
    -> GenLocated SrcSpanAnnN RdrName)
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc' (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc) FreeKiTyVars
implicit_vs
       ; [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name]
vars (RnM (a, FreeVars) -> RnM (a, FreeVars))
-> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$
         [Name] -> RnM (a, FreeVars)
thing_inside [Name]
vars }
rnImplicitTvBndrs :: HsDocContext
                  -> Maybe assoc
                  
                  -> FreeKiTyVars
                  
                  
                  -> ([Name] -> RnM (a, FreeVars))
                  -> RnM (a, FreeVars)
rnImplicitTvBndrs :: forall assoc a.
HsDocContext
-> Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnImplicitTvBndrs HsDocContext
ctx Maybe assoc
mb_assoc FreeKiTyVars
implicit_vs_with_dups [Name] -> RnM (a, FreeVars)
thing_inside
  = do { FreeKiTyVars
implicit_vs <- [NonEmpty (GenLocated SrcSpanAnnN RdrName)]
-> (NonEmpty (GenLocated SrcSpanAnnN RdrName)
    -> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnN RdrName))
-> RnM FreeKiTyVars
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((GenLocated SrcSpanAnnN RdrName
 -> GenLocated SrcSpanAnnN RdrName -> Bool)
-> FreeKiTyVars -> [NonEmpty (GenLocated SrcSpanAnnN RdrName)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN RdrName -> Bool
forall a l. Eq a => GenLocated l a -> GenLocated l a -> Bool
eqLocated (FreeKiTyVars -> [NonEmpty (GenLocated SrcSpanAnnN RdrName)])
-> FreeKiTyVars -> [NonEmpty (GenLocated SrcSpanAnnN RdrName)]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName
 -> GenLocated SrcSpanAnnN RdrName -> Ordering)
-> FreeKiTyVars -> FreeKiTyVars
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN RdrName -> Ordering
forall a l. Ord a => GenLocated l a -> GenLocated l a -> Ordering
cmpLocated (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ FreeKiTyVars
implicit_vs_with_dups) ((NonEmpty (GenLocated SrcSpanAnnN RdrName)
  -> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnN RdrName))
 -> RnM FreeKiTyVars)
-> (NonEmpty (GenLocated SrcSpanAnnN RdrName)
    -> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnN RdrName))
-> RnM FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ \case
           (GenLocated SrcSpanAnnN RdrName
x :| []) -> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnN RdrName)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnN RdrName
x
           (GenLocated SrcSpanAnnN RdrName
x :| FreeKiTyVars
_) -> do
             let msg :: TcRnMessage
msg = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
                   String -> SDoc
text String
"Variable" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"`" SDoc -> SDoc -> SDoc
<> GenLocated SrcSpanAnnN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnN RdrName
x SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"'" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"would be bound multiple times by" SDoc -> SDoc -> SDoc
<+> HsDocContext -> SDoc
pprHsDocContext HsDocContext
ctx SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"."
             TcRnMessage -> TcRn ()
addErr TcRnMessage
msg
             GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnN RdrName)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnN RdrName
x
       ; String -> SDoc -> TcRn ()
traceRn String
"rnImplicitTvBndrs" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
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 ]
       ; [Name]
vars <- (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 (Maybe assoc
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a.
Maybe a
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn Maybe assoc
mb_assoc) FreeKiTyVars
implicit_vs
       ; [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name]
vars (RnM (a, FreeVars) -> RnM (a, FreeVars))
-> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$
         [Name] -> RnM (a, FreeVars)
thing_inside [Name]
vars }
data RnTyKiEnv
  = RTKE { RnTyKiEnv -> HsDocContext
rtke_ctxt  :: HsDocContext
         , RnTyKiEnv -> TypeOrKind
rtke_level :: TypeOrKind  
         , RnTyKiEnv -> RnTyKiWhat
rtke_what  :: RnTyKiWhat  
         , RnTyKiEnv -> FreeVars
rtke_nwcs  :: NameSet     
    }
data RnTyKiWhat = RnTypeBody
                | RnTopConstraint   
                | RnConstraint      
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 -> FreeVars
rtke_nwcs = FreeVars
wcs, rtke_ctxt :: RnTyKiEnv -> HsDocContext
rtke_ctxt = HsDocContext
ctxt })
    = String -> SDoc
text String
"RTKE"
      SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces ([SDoc] -> SDoc
sep [ TypeOrKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeOrKind
lev, RnTyKiWhat -> SDoc
forall a. Outputable a => a -> SDoc
ppr RnTyKiWhat
what, FreeVars -> SDoc
forall a. Outputable a => a -> SDoc
ppr FreeVars
wcs
                      , HsDocContext -> SDoc
pprHsDocContext HsDocContext
ctxt ])
instance Outputable RnTyKiWhat where
  ppr :: RnTyKiWhat -> SDoc
ppr RnTyKiWhat
RnTypeBody      = String -> SDoc
text String
"RnTypeBody"
  ppr RnTyKiWhat
RnTopConstraint = String -> SDoc
text String
"RnTopConstraint"
  ppr RnTyKiWhat
RnConstraint    = String -> SDoc
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 :: FreeVars
rtke_nwcs = FreeVars
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
rnLHsType  :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsType :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsType HsDocContext
ctxt LHsType GhcPs
ty = RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody) LHsType GhcPs
ty
rnLHsTypes :: HsDocContext -> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
rnLHsTypes :: HsDocContext -> HsContext GhcPs -> RnM ([LHsType GhcRn], FreeVars)
rnLHsTypes HsDocContext
doc HsContext GhcPs
tys = (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsType HsDocContext
doc) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
rnScaledLHsType :: HsDocContext -> HsScaled GhcPs (LHsType GhcPs)
                                  -> RnM (HsScaled GhcRn (LHsType GhcRn), FreeVars)
rnScaledLHsType :: HsDocContext
-> HsScaled GhcPs (LHsType GhcPs)
-> RnM (HsScaled GhcRn (LHsType GhcRn), FreeVars)
rnScaledLHsType HsDocContext
doc (HsScaled HsArrow GhcPs
w LHsType GhcPs
ty) = do
  (HsArrow GhcRn
w' , FreeVars
fvs_w) <- RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars)
rnHsArrow (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
doc TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody) HsArrow GhcPs
w
  (GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) <- HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsType HsDocContext
doc LHsType GhcPs
ty
  (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)), FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsArrow GhcRn
-> GenLocated SrcSpanAnnA (HsType GhcRn)
-> HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled HsArrow GhcRn
w' GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_w)
rnHsType  :: HsDocContext -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rnHsType :: HsDocContext -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rnHsType HsDocContext
ctxt HsType GhcPs
ty = RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rnHsTyKi (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
TypeLevel RnTyKiWhat
RnTypeBody) HsType GhcPs
ty
rnLHsKind  :: HsDocContext -> LHsKind GhcPs -> RnM (LHsKind GhcRn, FreeVars)
rnLHsKind :: HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsKind HsDocContext
ctxt LHsType GhcPs
kind = RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
KindLevel RnTyKiWhat
RnTypeBody) LHsType GhcPs
kind
rnHsKind  :: HsDocContext -> HsKind GhcPs -> RnM (HsKind GhcRn, FreeVars)
rnHsKind :: HsDocContext -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rnHsKind HsDocContext
ctxt HsType GhcPs
kind = RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rnHsTyKi  (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctxt TypeOrKind
KindLevel RnTyKiWhat
RnTypeBody) HsType GhcPs
kind
rnLHsTypeArg :: HsDocContext -> LHsTypeArg GhcPs
                -> RnM (LHsTypeArg GhcRn, FreeVars)
rnLHsTypeArg :: HsDocContext
-> LHsTypeArg GhcPs -> RnM (LHsTypeArg GhcRn, FreeVars)
rnLHsTypeArg HsDocContext
ctxt (HsValArg LHsType GhcPs
ty)
   = do { (GenLocated SrcSpanAnnA (HsType GhcRn)
tys_rn, FreeVars
fvs) <- HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsType HsDocContext
ctxt LHsType GhcPs
ty
        ; (HsArg
   (GenLocated SrcSpanAnnA (HsType GhcRn))
   (GenLocated SrcSpanAnnA (HsType GhcRn)),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsArg
        (GenLocated SrcSpanAnnA (HsType GhcRn))
        (GenLocated SrcSpanAnnA (HsType GhcRn)),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsType GhcRn)
-> HsArg
     (GenLocated SrcSpanAnnA (HsType GhcRn))
     (GenLocated SrcSpanAnnA (HsType GhcRn))
forall tm ty. tm -> HsArg tm ty
HsValArg GenLocated SrcSpanAnnA (HsType GhcRn)
tys_rn, FreeVars
fvs) }
rnLHsTypeArg HsDocContext
ctxt (HsTypeArg SrcSpan
l LHsType GhcPs
ki)
   = do { (GenLocated SrcSpanAnnA (HsType GhcRn)
kis_rn, FreeVars
fvs) <- HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsKind HsDocContext
ctxt LHsType GhcPs
ki
        ; (HsArg
   (GenLocated SrcSpanAnnA (HsType GhcRn))
   (GenLocated SrcSpanAnnA (HsType GhcRn)),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsArg
        (GenLocated SrcSpanAnnA (HsType GhcRn))
        (GenLocated SrcSpanAnnA (HsType GhcRn)),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> GenLocated SrcSpanAnnA (HsType GhcRn)
-> HsArg
     (GenLocated SrcSpanAnnA (HsType GhcRn))
     (GenLocated SrcSpanAnnA (HsType GhcRn))
forall tm ty. SrcSpan -> ty -> HsArg tm ty
HsTypeArg SrcSpan
l GenLocated SrcSpanAnnA (HsType GhcRn)
kis_rn, FreeVars
fvs) }
rnLHsTypeArg HsDocContext
_ (HsArgPar SrcSpan
sp)
   = (HsArg
   (GenLocated SrcSpanAnnA (HsType GhcRn))
   (GenLocated SrcSpanAnnA (HsType GhcRn)),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsArg
        (GenLocated SrcSpanAnnA (HsType GhcRn))
        (GenLocated SrcSpanAnnA (HsType GhcRn)),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> HsArg
     (GenLocated SrcSpanAnnA (HsType GhcRn))
     (GenLocated SrcSpanAnnA (HsType GhcRn))
forall tm ty. SrcSpan -> HsArg tm ty
HsArgPar SrcSpan
sp, FreeVars
emptyFVs)
rnLHsTypeArgs :: HsDocContext -> [LHsTypeArg GhcPs]
                 -> RnM ([LHsTypeArg GhcRn], FreeVars)
rnLHsTypeArgs :: HsDocContext
-> [LHsTypeArg GhcPs] -> RnM ([LHsTypeArg GhcRn], FreeVars)
rnLHsTypeArgs HsDocContext
doc [LHsTypeArg GhcPs]
args = (HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (HsArg
         (GenLocated SrcSpanAnnA (HsType GhcRn))
         (GenLocated SrcSpanAnnA (HsType GhcRn)),
       FreeVars))
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType GhcPs))
      (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> RnM
     ([HsArg
         (GenLocated SrcSpanAnnA (HsType GhcRn))
         (GenLocated SrcSpanAnnA (HsType GhcRn))],
      FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (HsDocContext
-> LHsTypeArg GhcPs -> RnM (LHsTypeArg GhcRn, FreeVars)
rnLHsTypeArg HsDocContext
doc) [LHsTypeArg GhcPs]
[HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
args
rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs
              -> RnM (LHsContext GhcRn, FreeVars)
rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeVars)
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 :: RnTyKiWhat
rtke_what = RnTyKiWhat
RnConstraint }
       ; ([GenLocated SrcSpanAnnA (HsType GhcRn)]
cxt', FreeVars
fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env') [GenLocated SrcSpanAnnA (HsType GhcPs)]
cxt
       ; (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)],
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)],
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
loc [GenLocated SrcSpanAnnA (HsType GhcRn)]
cxt', FreeVars
fvs) }
rnContext :: HsDocContext -> LHsContext GhcPs
          -> RnM (LHsContext GhcRn, FreeVars)
rnContext :: HsDocContext
-> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeVars)
rnContext HsDocContext
doc LHsContext GhcPs
theta = RnTyKiEnv -> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeVars)
rnTyKiContext (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
doc TypeOrKind
TypeLevel RnTyKiWhat
RnConstraint) LHsContext GhcPs
theta
rnMaybeContext :: HsDocContext -> Maybe (LHsContext GhcPs)
          -> RnM (Maybe (LHsContext GhcRn), FreeVars)
rnMaybeContext :: HsDocContext
-> Maybe (LHsContext GhcPs)
-> RnM (Maybe (LHsContext GhcRn), FreeVars)
rnMaybeContext HsDocContext
_ Maybe (LHsContext GhcPs)
Nothing = (Maybe
   (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Maybe
        (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]),
      FreeVars)
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, FreeVars
emptyFVs)
rnMaybeContext HsDocContext
doc (Just LHsContext GhcPs
theta)
  = do { (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
theta', FreeVars
fvs) <- HsDocContext
-> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeVars)
rnContext HsDocContext
doc LHsContext GhcPs
theta
       ; (Maybe
   (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]),
 FreeVars)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Maybe
        (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]),
      FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)])
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
theta', FreeVars
fvs)
       }
rnLHsTyKi  :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env (L SrcSpanAnnA
loc HsType GhcPs
ty)
  = SrcSpanAnnA
-> RnM (LHsType GhcRn, FreeVars) -> RnM (LHsType GhcRn, FreeVars)
forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnA
loc (RnM (LHsType GhcRn, FreeVars) -> RnM (LHsType GhcRn, FreeVars))
-> RnM (LHsType GhcRn, FreeVars) -> RnM (LHsType GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$
    do { (HsType GhcRn
ty', FreeVars
fvs) <- RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rnHsTyKi RnTyKiEnv
env HsType GhcPs
ty
       ; (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsType GhcRn
ty', FreeVars
fvs) }
rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
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 -> HsType GhcPs -> TcRn ()
forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
checkPolyKinds RnTyKiEnv
env HsType GhcPs
ty
       ; HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeVars))
-> RnM (HsType GhcRn, FreeVars)
forall a.
HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
bindHsForAllTelescope (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) HsForAllTelescope GhcPs
tele ((HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeVars))
 -> RnM (HsType GhcRn, FreeVars))
-> (HsForAllTelescope GhcRn -> RnM (HsType GhcRn, FreeVars))
-> RnM (HsType GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ HsForAllTelescope GhcRn
tele' ->
    do { (GenLocated SrcSpanAnnA (HsType GhcRn)
tau',  FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
tau
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( HsForAllTy { hst_xforall :: XForAllTy GhcRn
hst_xforall = XForAllTy GhcRn
NoExtField
noExtField
                             , hst_tele :: HsForAllTelescope GhcRn
hst_tele = HsForAllTelescope GhcRn
tele' , hst_body :: LHsType GhcRn
hst_body =  LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
tau' }
                , FreeVars
fvs) } }
rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(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 { Bool
data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds 
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
data_kinds Bool -> Bool -> Bool
&& RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env)
              (TcRnMessage -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> TcRnMessage
dataKindsErr RnTyKiEnv
env HsType GhcPs
ty))
       ; (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
ctxt', FreeVars
fvs1) <- RnTyKiEnv -> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeVars)
rnTyKiContext RnTyKiEnv
env LHsContext GhcPs
lctxt
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
tau',  FreeVars
fvs2) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
tau
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsQualTy { hst_xqual :: XQualTy GhcRn
hst_xqual = XQualTy GhcRn
NoExtField
noExtField, hst_ctxt :: LHsContext GhcRn
hst_ctxt = LHsContext GhcRn
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
ctxt'
                          , hst_body :: LHsType GhcRn
hst_body =  LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
tau' }
                , FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }
rnHsTyKi RnTyKiEnv
env (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
$ DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
         HsDocContext -> SDoc -> SDoc
withHsDocContext (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Unexpected kind variable" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
              , String -> SDoc
text String
"Perhaps you intended to use PolyKinds" ]
           
           
       ; Name
name <- RnTyKiEnv -> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
rnTyVar RnTyKiEnv
env RdrName
rdr_name
       ; 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
TcRnUntickedPromotedThing (UntickedPromotedThing -> TcRnMessage)
-> UntickedPromotedThing -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ LexicalFixity -> Name -> UntickedPromotedThing
UntickedConstructor LexicalFixity
Prefix Name
name)
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XTyVar GhcRn -> PromotionFlag -> LIdP GhcRn -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
ip (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc Name
name), Name -> FreeVars
unitFV Name
name) }
rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsOpTy XOpTy GhcPs
_ PromotionFlag
prom LHsType GhcPs
ty1 LIdP GhcPs
l_op LHsType GhcPs
ty2)
  = SrcSpan
-> RnM (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
l_op) (RnM (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars))
-> RnM (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$
    do  { (GenLocated SrcSpanAnnN Name
l_op', FreeVars
fvs1) <- RnTyKiEnv
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> RnM (GenLocated SrcSpanAnnN Name, FreeVars)
rnHsTyOp RnTyKiEnv
env (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
ty) LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
l_op
        ; let op_name :: Name
op_name = GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN Name
l_op'
        ; Fixity
fix   <- GenLocated SrcSpanAnnN Name -> RnM Fixity
lookupTyFixityRn GenLocated SrcSpanAnnN Name
l_op'
        ; (GenLocated SrcSpanAnnA (HsType GhcRn)
ty1', FreeVars
fvs2) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty1
        ; (GenLocated SrcSpanAnnA (HsType GhcRn)
ty2', FreeVars
fvs3) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty2
        ; HsType GhcRn
res_ty <- PromotionFlag
-> GenLocated SrcSpanAnnN Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> RnM (HsType GhcRn)
mkHsOpTyRn PromotionFlag
prom GenLocated SrcSpanAnnN Name
l_op' Fixity
fix LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty1' LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty2'
        ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
isDataConName Name
op_name Bool -> Bool -> Bool
&& Bool -> Bool
not (PromotionFlag -> Bool
isPromoted PromotionFlag
prom)) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
            TcRnMessage -> TcRn ()
addDiagnostic (UntickedPromotedThing -> TcRnMessage
TcRnUntickedPromotedThing (UntickedPromotedThing -> TcRnMessage)
-> UntickedPromotedThing -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ LexicalFixity -> Name -> UntickedPromotedThing
UntickedConstructor LexicalFixity
Infix Name
op_name)
        ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType GhcRn
res_ty, [FreeVars] -> FreeVars
plusFVs [FreeVars
fvs1, FreeVars
fvs2, FreeVars
fvs3]) }
rnHsTyKi RnTyKiEnv
env (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty)
  = do { (GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XParTy GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcRn
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) }
rnHsTyKi RnTyKiEnv
env (HsBangTy XBangTy GhcPs
x HsSrcBang
b LHsType GhcPs
ty)
  = do { (GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XBangTy GhcRn -> HsSrcBang -> LHsType GhcRn -> HsType GhcRn
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy XBangTy GhcPs
XBangTy GhcRn
x HsSrcBang
b LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) }
rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsRecTy XRecTy GhcPs
_ [LConDeclField GhcPs]
flds)
  = do { let ctxt :: HsDocContext
ctxt = RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env
       ; [FieldLabel]
fls          <- HsDocContext -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
get_fields HsDocContext
ctxt
       ; ([GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
flds', FreeVars
fvs) <- HsDocContext
-> [FieldLabel]
-> [LConDeclField GhcPs]
-> RnM ([LConDeclField GhcRn], FreeVars)
rnConDeclFields HsDocContext
ctxt [FieldLabel]
fls [LConDeclField GhcPs]
flds
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRecTy GhcRn -> [LConDeclField GhcRn] -> HsType GhcRn
forall pass. XRecTy pass -> [LConDeclField pass] -> HsType pass
HsRecTy XRecTy GhcRn
NoExtField
noExtField [LConDeclField GhcRn]
[GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
flds', FreeVars
fvs) }
  where
    get_fields :: HsDocContext -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
get_fields (ConDeclCtx [GenLocated SrcSpanAnnN Name]
names)
      = (GenLocated SrcSpanAnnN Name
 -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel])
-> [GenLocated SrcSpanAnnN Name]
-> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Name -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
lookupConstructorFields (Name -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel])
-> (GenLocated SrcSpanAnnN Name -> Name)
-> GenLocated SrcSpanAnnN Name
-> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnN Name]
names
    get_fields HsDocContext
_
      = do { TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
               (SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Record syntax is illegal here:") Int
2 (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
ty))
           ; [FieldLabel] -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
rnHsTyKi RnTyKiEnv
env (HsFunTy XFunTy GhcPs
u HsArrow GhcPs
mult LHsType GhcPs
ty1 LHsType GhcPs
ty2)
  = do { (GenLocated SrcSpanAnnA (HsType GhcRn)
ty1', FreeVars
fvs1) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty1
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
ty2', FreeVars
fvs2) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty2
       ; (HsArrow GhcRn
mult', FreeVars
w_fvs) <- RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars)
rnHsArrow RnTyKiEnv
env HsArrow GhcPs
mult
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XFunTy GhcRn
-> HsArrow GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcPs
XFunTy GhcRn
u HsArrow GhcRn
mult' LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty1' LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty2'
                , [FreeVars] -> FreeVars
plusFVs [FreeVars
fvs1, FreeVars
fvs2, FreeVars
w_fvs]) }
rnHsTyKi RnTyKiEnv
env listTy :: HsType GhcPs
listTy@(HsListTy XListTy GhcPs
x LHsType GhcPs
ty)
  = do { Bool
data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
data_kinds Bool -> Bool -> Bool
&& RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env)
              (TcRnMessage -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> TcRnMessage
dataKindsErr RnTyKiEnv
env HsType GhcPs
listTy))
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XListTy GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy XListTy GhcPs
XListTy GhcRn
x LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) }
rnHsTyKi RnTyKiEnv
env (HsKindSig XKindSig GhcPs
x LHsType GhcPs
ty LHsType GhcPs
k)
  = do { Bool
kind_sigs_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.KindSignatures
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
kind_sigs_ok (HsDocContext -> LHsType GhcPs -> TcRn ()
badKindSigErr (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) LHsType GhcPs
ty)
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
lhs_fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
k', FreeVars
sig_fvs)  <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi (RnTyKiEnv
env { rtke_level :: TypeOrKind
rtke_level = TypeOrKind
KindLevel }) LHsType GhcPs
k
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XKindSig GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
HsKindSig XKindSig GhcPs
XKindSig GhcRn
x LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty' LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
k', FreeVars
lhs_fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
sig_fvs) }
rnHsTyKi RnTyKiEnv
env tupleTy :: HsType GhcPs
tupleTy@(HsTupleTy XTupleTy GhcPs
x HsTupleSort
tup_con HsContext GhcPs
tys)
  = do { Bool
data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
data_kinds Bool -> Bool -> Bool
&& RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env)
              (TcRnMessage -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> TcRnMessage
dataKindsErr RnTyKiEnv
env HsType GhcPs
tupleTy))
       ; ([GenLocated SrcSpanAnnA (HsType GhcRn)]
tys', FreeVars
fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XTupleTy GhcRn -> HsTupleSort -> [LHsType GhcRn] -> HsType GhcRn
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy XTupleTy GhcPs
XTupleTy GhcRn
x HsTupleSort
tup_con [LHsType GhcRn]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
tys', FreeVars
fvs) }
rnHsTyKi RnTyKiEnv
env sumTy :: HsType GhcPs
sumTy@(HsSumTy XSumTy GhcPs
x HsContext GhcPs
tys)
  = do { Bool
data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
data_kinds Bool -> Bool -> Bool
&& RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env)
              (TcRnMessage -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> TcRnMessage
dataKindsErr RnTyKiEnv
env HsType GhcPs
sumTy))
       ; ([GenLocated SrcSpanAnnA (HsType GhcRn)]
tys', FreeVars
fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XSumTy GhcRn -> [LHsType GhcRn] -> HsType GhcRn
forall pass. XSumTy pass -> [LHsType pass] -> HsType pass
HsSumTy XSumTy GhcPs
XSumTy GhcRn
x [LHsType GhcRn]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
tys', FreeVars
fvs) }
rnHsTyKi RnTyKiEnv
env tyLit :: HsType GhcPs
tyLit@(HsTyLit XTyLit GhcPs
_ HsTyLit
t)
  = do { Bool
data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
data_kinds (TcRnMessage -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> TcRnMessage
dataKindsErr RnTyKiEnv
env HsType GhcPs
tyLit))
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HsTyLit -> Bool
negLit HsTyLit
t) (TcRnMessage -> TcRn ()
addErr TcRnMessage
negLitErr)
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XTyLit GhcRn -> HsTyLit -> HsType GhcRn
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit XTyLit GhcRn
NoExtField
noExtField HsTyLit
t, FreeVars
emptyFVs) }
  where
    negLit :: HsTyLit -> Bool
negLit (HsStrTy SourceText
_ FastString
_) = Bool
False
    negLit (HsNumTy SourceText
_ Integer
i) = Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
    negLit (HsCharTy SourceText
_ Char
_) = Bool
False
    negLitErr :: TcRnMessage
    negLitErr :: TcRnMessage
negLitErr = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
text String
"Illegal literal in type (type literals must not be negative):" SDoc -> SDoc -> SDoc
<+> HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
tyLit
rnHsTyKi RnTyKiEnv
env (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2)
  = do { (GenLocated SrcSpanAnnA (HsType GhcRn)
ty1', FreeVars
fvs1) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty1
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
ty2', FreeVars
fvs2) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty2
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XAppTy GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy GhcRn
NoExtField
noExtField LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty1' LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty2', FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }
rnHsTyKi RnTyKiEnv
env (HsAppKindTy XAppKindTy GhcPs
l LHsType GhcPs
ty LHsType GhcPs
k)
  = do { Bool
kind_app <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeApplications
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
kind_app (TcRnMessage -> TcRn ()
addErr (String -> LHsType GhcPs -> TcRnMessage
typeAppErr String
"kind" LHsType GhcPs
k))
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs1) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
k', FreeVars
fvs2) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi (RnTyKiEnv
env {rtke_level :: TypeOrKind
rtke_level = TypeOrKind
KindLevel }) LHsType GhcPs
k
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XAppKindTy GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XAppKindTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy GhcPs
XAppKindTy GhcRn
l LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty' LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
k', FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }
rnHsTyKi RnTyKiEnv
env t :: HsType GhcPs
t@(HsIParamTy XIParamTy GhcPs
x XRec GhcPs HsIPName
n LHsType GhcPs
ty)
  = do { RnTyKiEnv -> HsType GhcPs -> TcRn ()
forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
notInKinds RnTyKiEnv
env HsType GhcPs
t
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XIParamTy GhcRn
-> XRec GhcRn HsIPName -> LHsType GhcRn -> HsType GhcRn
forall pass.
XIParamTy pass -> XRec pass HsIPName -> LHsType pass -> HsType pass
HsIParamTy XIParamTy GhcPs
XIParamTy GhcRn
x XRec GhcPs HsIPName
XRec GhcRn HsIPName
n LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) }
rnHsTyKi RnTyKiEnv
_ (HsStarTy XStarTy GhcPs
_ Bool
isUni)
  = (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XStarTy GhcRn -> Bool -> HsType GhcRn
forall pass. XStarTy pass -> Bool -> HsType pass
HsStarTy XStarTy GhcRn
NoExtField
noExtField Bool
isUni, FreeVars
emptyFVs)
rnHsTyKi RnTyKiEnv
_ (HsSpliceTy XSpliceTy GhcPs
_ HsSplice GhcPs
sp)
  = HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)
rnSpliceType HsSplice GhcPs
sp
rnHsTyKi RnTyKiEnv
env (HsDocTy XDocTy GhcPs
x LHsType GhcPs
ty LHsDoc GhcPs
haddock_doc)
  = do { (GenLocated SrcSpanAnnA (HsType GhcRn)
ty', FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; LHsDoc GhcRn
haddock_doc' <- LHsDoc GhcPs -> RnM (LHsDoc GhcRn)
rnLHsDoc LHsDoc GhcPs
haddock_doc
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XDocTy GhcRn -> LHsType GhcRn -> LHsDoc GhcRn -> HsType GhcRn
forall pass.
XDocTy pass -> LHsType pass -> LHsDoc pass -> HsType pass
HsDocTy XDocTy GhcPs
XDocTy GhcRn
x LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty' LHsDoc GhcRn
haddock_doc', FreeVars
fvs) }
rnHsTyKi RnTyKiEnv
env (XHsType XXType GhcPs
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, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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 GhcPs
XXType GhcRn
ty, FreeVars
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
$ Type -> [TyCoVar]
tyCoVarsOfTypeList XXType GhcPs
Type
ty
    fvs :: FreeVars
fvs = [Name] -> FreeVars
mkFVs [Name]
fvs_list
    check_in_scope :: RdrName -> RnM ()
    check_in_scope :: RdrName -> TcRn ()
check_in_scope RdrName
rdr_name = do
      Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
      
      Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Name -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Name
mb_name) (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
$ DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
          HsDocContext -> SDoc -> SDoc
withHsDocContext (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
          RdrName -> NotInScopeError -> SDoc
pprScopeError RdrName
rdr_name (WhereLooking -> RdrName -> NotInScopeError
notInScopeErr WhereLooking
WL_LocalOnly RdrName
rdr_name)
rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsExplicitListTy XExplicitListTy GhcPs
_ PromotionFlag
ip HsContext GhcPs
tys)
  = do { Bool
data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
data_kinds (TcRnMessage -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> TcRnMessage
dataKindsErr RnTyKiEnv
env HsType GhcPs
ty))
       ; ([GenLocated SrcSpanAnnA (HsType GhcRn)]
tys', FreeVars
fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PromotionFlag -> Bool
isPromoted PromotionFlag
ip) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
           TcRnMessage -> TcRn ()
addDiagnostic (UntickedPromotedThing -> TcRnMessage
TcRnUntickedPromotedThing (UntickedPromotedThing -> TcRnMessage)
-> UntickedPromotedThing -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ UntickedPromotedThing
UntickedExplicitList)
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitListTy GhcRn
-> PromotionFlag -> [LHsType GhcRn] -> HsType GhcRn
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy XExplicitListTy GhcRn
NoExtField
noExtField PromotionFlag
ip [LHsType GhcRn]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
tys', FreeVars
fvs) }
rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsExplicitTupleTy XExplicitTupleTy GhcPs
_ HsContext GhcPs
tys)
  = do { Bool
data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
data_kinds (TcRnMessage -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> TcRnMessage
dataKindsErr RnTyKiEnv
env HsType GhcPs
ty))
       ; ([GenLocated SrcSpanAnnA (HsType GhcRn)]
tys', FreeVars
fvs) <- (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> RnM ([GenLocated SrcSpanAnnA (HsType GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env) HsContext GhcPs
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitTupleTy GhcRn -> [LHsType GhcRn] -> HsType GhcRn
forall pass. XExplicitTupleTy pass -> [LHsType pass] -> HsType pass
HsExplicitTupleTy XExplicitTupleTy GhcRn
NoExtField
noExtField [LHsType GhcRn]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
tys', FreeVars
fvs) }
rnHsTyKi RnTyKiEnv
env (HsWildCardTy XWildCardTy GhcPs
_)
  = do { RnTyKiEnv -> TcRn ()
checkAnonWildCard RnTyKiEnv
env
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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, FreeVars
emptyFVs) }
rnHsArrow :: RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars)
rnHsArrow :: RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars)
rnHsArrow RnTyKiEnv
_env (HsUnrestrictedArrow LHsUniToken "->" "\8594" GhcPs
arr) = (HsArrow GhcRn, FreeVars) -> RnM (HsArrow GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsUniToken "->" "\8594" GhcRn -> HsArrow GhcRn
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow LHsUniToken "->" "\8594" GhcPs
LHsUniToken "->" "\8594" GhcRn
arr, FreeVars
emptyFVs)
rnHsArrow RnTyKiEnv
_env (HsLinearArrow (HsPct1 LHsToken "%1" GhcPs
pct1 LHsUniToken "->" "\8594" GhcPs
arr)) = (HsArrow GhcRn, FreeVars) -> RnM (HsArrow GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLinearArrowTokens GhcRn -> HsArrow GhcRn
forall pass. HsLinearArrowTokens pass -> HsArrow pass
HsLinearArrow (LHsToken "%1" GhcRn
-> LHsUniToken "->" "\8594" GhcRn -> HsLinearArrowTokens GhcRn
forall pass.
LHsToken "%1" pass
-> LHsUniToken "->" "\8594" pass -> HsLinearArrowTokens pass
HsPct1 LHsToken "%1" GhcPs
LHsToken "%1" GhcRn
pct1 LHsUniToken "->" "\8594" GhcPs
LHsUniToken "->" "\8594" GhcRn
arr), FreeVars
emptyFVs)
rnHsArrow RnTyKiEnv
_env (HsLinearArrow (HsLolly LHsToken "\8888" GhcPs
arr)) = (HsArrow GhcRn, FreeVars) -> RnM (HsArrow GhcRn, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLinearArrowTokens GhcRn -> HsArrow GhcRn
forall pass. HsLinearArrowTokens pass -> HsArrow pass
HsLinearArrow (LHsToken "\8888" GhcRn -> HsLinearArrowTokens GhcRn
forall pass. LHsToken "\8888" pass -> HsLinearArrowTokens pass
HsLolly LHsToken "\8888" GhcPs
LHsToken "\8888" GhcRn
arr), FreeVars
emptyFVs)
rnHsArrow RnTyKiEnv
env (HsExplicitMult LHsToken "%" GhcPs
pct LHsType GhcPs
p LHsUniToken "->" "\8594" GhcPs
arr)
  = (\(GenLocated SrcSpanAnnA (HsType GhcRn)
mult, FreeVars
fvs) -> (LHsToken "%" GhcRn
-> LHsType GhcRn -> LHsUniToken "->" "\8594" GhcRn -> HsArrow GhcRn
forall pass.
LHsToken "%" pass
-> LHsType pass -> LHsUniToken "->" "\8594" pass -> HsArrow pass
HsExplicitMult LHsToken "%" GhcPs
LHsToken "%" GhcRn
pct LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
mult LHsUniToken "->" "\8594" GhcPs
LHsUniToken "->" "\8594" GhcRn
arr, FreeVars
fvs)) ((GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
 -> (HsArrow GhcRn, FreeVars))
-> RnM (GenLocated SrcSpanAnnA (HsType GhcRn), FreeVars)
-> RnM (HsArrow GhcRn, FreeVars)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
p
rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name
rnTyVar :: RnTyKiEnv -> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
rnTyVar RnTyKiEnv
env RdrName
rdr_name
  = do { Name
name <- RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupTypeOccRn RdrName
rdr_name
       ; RnTyKiEnv -> Name -> TcRn ()
checkNamedWildCard RnTyKiEnv
env Name
name
       ; Name -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
rnLTyVar :: LocatedN RdrName -> RnM (LocatedN Name)
rnLTyVar :: GenLocated SrcSpanAnnN RdrName -> RnM (GenLocated SrcSpanAnnN Name)
rnLTyVar (L SrcSpanAnnN
loc RdrName
rdr_name)
  = do { Name
tyvar <- RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupTypeOccRn RdrName
rdr_name
       ; GenLocated SrcSpanAnnN Name -> RnM (GenLocated SrcSpanAnnN Name)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc Name
tyvar) }
rnHsTyOp :: RnTyKiEnv -> SDoc -> LocatedN RdrName
         -> RnM (LocatedN Name, FreeVars)
rnHsTyOp :: RnTyKiEnv
-> SDoc
-> GenLocated SrcSpanAnnN RdrName
-> RnM (GenLocated SrcSpanAnnN Name, FreeVars)
rnHsTyOp RnTyKiEnv
env SDoc
overall_ty (L SrcSpanAnnN
loc RdrName
op)
  = do { Name
op' <- RnTyKiEnv -> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
rnTyVar RnTyKiEnv
env RdrName
op
       ; Extension -> TcRn () -> TcRn ()
forall gbl lcl. Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
unlessXOptM Extension
LangExt.TypeOperators (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
           if (Name
op' Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey) 
           then TcRnMessage -> TcRn ()
addDiagnostic TcRnMessage
TcRnTypeEqualityRequiresOperators
           else TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ SDoc -> RdrName -> TcRnMessage
TcRnIllegalTypeOperator SDoc
overall_ty RdrName
op
       ; (GenLocated SrcSpanAnnN Name, FreeVars)
-> RnM (GenLocated SrcSpanAnnN Name, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc Name
op', Name -> FreeVars
unitFV Name
op') }
checkWildCard :: RnTyKiEnv
              -> Maybe Name 
                            
              -> 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
$ Maybe Name
-> BadAnonWildcardContext -> Maybe HsDocContext -> TcRnMessage
TcRnIllegalWildcardInType Maybe Name
mb_name BadAnonWildcardContext
bad (HsDocContext -> Maybe HsDocContext
forall a. a -> Maybe a
Just (HsDocContext -> Maybe HsDocContext)
-> HsDocContext -> Maybe HsDocContext
forall a b. (a -> b) -> a -> b
$ RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env)
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 ()
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 ()
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 -> FreeVars -> Bool
`elemNameSet` RnTyKiEnv -> FreeVars
rtke_nwcs RnTyKiEnv
env)
           = Maybe BadAnonWildcardContext
forall a. Maybe a
Nothing  
           | 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 -> Maybe BadAnonWildcardContext
forall a. Maybe a
Nothing   
                  
                  
                  
               RnTyKiWhat
RnConstraint    -> BadAnonWildcardContext -> Maybe BadAnonWildcardContext
forall a. a -> Maybe a
Just BadAnonWildcardContext
WildcardNotLastInConstraint
wildCardsAllowed :: RnTyKiEnv -> Bool
wildCardsAllowed :: RnTyKiEnv -> Bool
wildCardsAllowed RnTyKiEnv
env
   = case RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env of
       TypeSigCtx {}       -> Bool
True
       TypBrCtx {}         -> Bool
True   
       SpliceTypeCtx {}    -> Bool
True   
       ExprWithTySigCtx {} -> Bool
True
       PatCtx {}           -> Bool
True
       RuleCtx {}          -> Bool
True
       FamPatCtx {}        -> Bool
True   
       GHCiCtx {}          -> Bool
True
       HsTypeCtx {}        -> Bool
True
       StandaloneKindSigCtx {} -> Bool
False  
       HsDocContext
_                   -> Bool
False
checkPolyKinds :: Outputable ty
                => RnTyKiEnv
                -> ty      
                -> RnM ()
checkPolyKinds :: forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
checkPolyKinds RnTyKiEnv
env ty
ty
  | RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env
  = do { Bool
polykinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.PolyKinds
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
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
$ DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
           (String -> SDoc
text String
"Illegal kind:" SDoc -> SDoc -> SDoc
<+> ty -> SDoc
forall a. Outputable a => a -> SDoc
ppr ty
ty SDoc -> SDoc -> SDoc
$$
            String -> SDoc
text String
"Did you mean to enable PolyKinds?") }
checkPolyKinds RnTyKiEnv
_ ty
_ = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
notInKinds :: Outputable ty
           => RnTyKiEnv
           -> ty
           -> RnM ()
notInKinds :: forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
notInKinds RnTyKiEnv
env ty
ty
  | RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env
  = TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
     String -> SDoc
text String
"Illegal kind:" SDoc -> SDoc -> SDoc
<+> ty -> SDoc
forall a. Outputable a => a -> SDoc
ppr ty
ty
notInKinds RnTyKiEnv
_ ty
_ = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
bindSigTyVarsFV :: [Name]
                -> RnM (a, FreeVars)
                -> RnM (a, FreeVars)
bindSigTyVarsFV :: forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindSigTyVarsFV [Name]
tvs RnM (a, FreeVars)
thing_inside
  = do  { Bool
scoped_tyvars <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.ScopedTypeVariables
        ; if Bool -> Bool
not Bool
scoped_tyvars then
                RnM (a, FreeVars)
thing_inside
          else
                [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name]
tvs RnM (a, FreeVars)
thing_inside }
bindHsQTyVars :: forall a b.
                 HsDocContext
              -> Maybe a            
              -> FreeKiTyVars       
              -> LHsQTyVars GhcPs
              -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars))
                  
                  
                  
                  
              -> RnM (b, FreeVars)
bindHsQTyVars :: forall a b.
HsDocContext
-> Maybe a
-> FreeKiTyVars
-> LHsQTyVars GhcPs
-> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindHsQTyVars HsDocContext
doc Maybe a
mb_assoc FreeKiTyVars
body_kv_occs LHsQTyVars GhcPs
hsq_bndrs LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)
thing_inside
  = do { let bndr_kv_occs :: FreeKiTyVars
bndr_kv_occs = [LHsTyVarBndr () GhcPs] -> FreeKiTyVars
forall flag. [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
extractHsTyVarBndrsKVs [LHsTyVarBndr () GhcPs]
hs_tv_bndrs
       ; let 
             
             bndrs, implicit_kvs :: [LocatedN RdrName]
             bndrs :: FreeKiTyVars
bndrs        = (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
 -> GenLocated SrcSpanAnnN RdrName)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> FreeKiTyVars
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr () GhcPs -> LocatedN (IdP GhcPs)
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> GenLocated SrcSpanAnnN RdrName
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
hsLTyVarLocName [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
hs_tv_bndrs
             implicit_kvs :: FreeKiTyVars
implicit_kvs = FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
filterFreeVarsToBind 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
filterFreeVarsToBind FreeKiTyVars
bndr_kv_occs (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
              FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
filterFreeVarsToBind FreeKiTyVars
bndrs FreeKiTyVars
body_kv_occs
             all_bound_on_lhs :: Bool
all_bound_on_lhs = FreeKiTyVars -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FreeKiTyVars
body_remaining
       ; String -> SDoc -> TcRn ()
traceRn String
"checkMixedVars3" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"bndrs"   SDoc -> SDoc -> SDoc
<+> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
hs_tv_bndrs
                , String -> SDoc
text String
"bndr_kv_occs"   SDoc -> SDoc -> SDoc
<+> FreeKiTyVars -> SDoc
forall a. Outputable a => a -> SDoc
ppr FreeKiTyVars
bndr_kv_occs
                , String -> SDoc
text String
"body_kv_occs"   SDoc -> SDoc -> SDoc
<+> FreeKiTyVars -> SDoc
forall a. Outputable a => a -> SDoc
ppr FreeKiTyVars
body_kv_occs
                , String -> SDoc
text String
"implicit_kvs"   SDoc -> SDoc -> SDoc
<+> FreeKiTyVars -> SDoc
forall a. Outputable a => a -> SDoc
ppr FreeKiTyVars
implicit_kvs
                , String -> SDoc
text String
"body_remaining" SDoc -> SDoc -> SDoc
<+> FreeKiTyVars -> SDoc
forall a. Outputable a => a -> SDoc
ppr FreeKiTyVars
body_remaining
                ]
       ; Maybe a
-> FreeKiTyVars
-> ([Name] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
forall assoc a.
Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnImplicitTvOccs Maybe a
mb_assoc FreeKiTyVars
implicit_kvs (([Name] -> RnM (b, FreeVars)) -> RnM (b, FreeVars))
-> ([Name] -> RnM (b, FreeVars)) -> RnM (b, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
implicit_kv_nms' ->
         HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr () GhcPs]
-> ([LHsTyVarBndr () GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
NoWarnUnusedForalls Maybe a
mb_assoc [LHsTyVarBndr () GhcPs]
hs_tv_bndrs (([LHsTyVarBndr () GhcRn] -> RnM (b, FreeVars))
 -> RnM (b, FreeVars))
-> ([LHsTyVarBndr () GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [LHsTyVarBndr () GhcRn]
rn_bndrs ->
           
           
           
    do { let 
             
             
             
             
             
             implicit_kv_nms :: [Name]
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'
       ; String -> SDoc -> TcRn ()
traceRn String
"bindHsQTyVars" (LHsQTyVars GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsQTyVars GhcPs
hsq_bndrs SDoc -> SDoc -> SDoc
$$ [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
implicit_kv_nms SDoc -> SDoc -> SDoc
$$ [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr () GhcRn]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)]
rn_bndrs)
       ; LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)
thing_inside (HsQTvs { hsq_ext :: XHsQTvs GhcRn
hsq_ext = [Name]
XHsQTvs GhcRn
implicit_kv_nms
                              , hsq_explicit :: [LHsTyVarBndr () GhcRn]
hsq_explicit  = [LHsTyVarBndr () GhcRn]
rn_bndrs })
                      Bool
all_bound_on_lhs } }
  where
    hs_tv_bndrs :: [LHsTyVarBndr () GhcPs]
hs_tv_bndrs = LHsQTyVars GhcPs -> [LHsTyVarBndr () GhcPs]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsQTvExplicit LHsQTyVars GhcPs
hsq_bndrs
    
    
    
    
    
    bndrs_loc :: SrcSpan
bndrs_loc = case (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr () GhcPs -> SrcSpan
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> SrcSpan
get_bndr_loc [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () 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. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA FreeKiTyVars
body_kv_occs of
      []         -> String -> SrcSpan
forall a. 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
    
    
    
    get_bndr_loc :: LHsTyVarBndr () GhcPs -> SrcSpan
    get_bndr_loc :: LHsTyVarBndr () GhcPs -> SrcSpan
get_bndr_loc (L SrcSpanAnnA
_ (UserTyVar   XUserTyVar GhcPs
_ ()
_ LIdP GhcPs
ln)) = GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
ln
    get_bndr_loc (L SrcSpanAnnA
_ (KindedTyVar XKindedTyVar GhcPs
_ ()
_ LIdP GhcPs
ln LHsType GhcPs
lk))
      = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
ln) (GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lk)
bindHsOuterTyVarBndrs :: OutputableBndrFlag flag 'Renamed
                      => HsDocContext
                      -> Maybe assoc
                         
                      -> FreeKiTyVars
                      -> HsOuterTyVarBndrs flag GhcPs
                      -> (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars))
                      -> RnM (a, FreeVars)
bindHsOuterTyVarBndrs :: forall flag assoc a.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> Maybe assoc
-> FreeKiTyVars
-> HsOuterTyVarBndrs flag GhcPs
-> (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
bindHsOuterTyVarBndrs HsDocContext
doc Maybe assoc
mb_cls FreeKiTyVars
implicit_vars HsOuterTyVarBndrs flag GhcPs
outer_bndrs HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars)
thing_inside =
  case HsOuterTyVarBndrs flag GhcPs
outer_bndrs of
    HsOuterImplicit{} ->
      Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall assoc a.
Maybe assoc
-> FreeKiTyVars
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnImplicitTvOccs Maybe assoc
mb_cls FreeKiTyVars
implicit_vars (([Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars))
-> ([Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ \[Name]
implicit_vars' ->
        HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars)
thing_inside (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars))
-> HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars)
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} ->
      
      
      
      
      HsDocContext
-> WarnUnusedForalls
-> Maybe Any
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
WarnUnusedForalls Maybe Any
forall a. Maybe a
Nothing [LHsTyVarBndr flag (NoGhcTc GhcPs)]
[LHsTyVarBndr flag GhcPs]
exp_bndrs (([LHsTyVarBndr flag GhcRn] -> RnM (a, FreeVars))
 -> RnM (a, FreeVars))
-> ([LHsTyVarBndr flag GhcRn] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ \[LHsTyVarBndr flag GhcRn]
exp_bndrs' ->
        HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars)
thing_inside (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars))
-> HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars)
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' }
bindHsForAllTelescope :: HsDocContext
                      -> HsForAllTelescope GhcPs
                      -> (HsForAllTelescope GhcRn -> RnM (a, FreeVars))
                      -> RnM (a, FreeVars)
bindHsForAllTelescope :: forall a.
HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
bindHsForAllTelescope HsDocContext
doc HsForAllTelescope GhcPs
tele HsForAllTelescope GhcRn -> RnM (a, FreeVars)
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 Any
-> [LHsTyVarBndr () GhcPs]
-> ([LHsTyVarBndr () GhcRn] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
WarnUnusedForalls Maybe Any
forall a. Maybe a
Nothing [LHsTyVarBndr () GhcPs]
bndrs (([LHsTyVarBndr () GhcRn] -> RnM (a, FreeVars))
 -> RnM (a, FreeVars))
-> ([LHsTyVarBndr () GhcRn] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ \[LHsTyVarBndr () GhcRn]
bndrs' ->
        HsForAllTelescope GhcRn -> RnM (a, FreeVars)
thing_inside (HsForAllTelescope GhcRn -> RnM (a, FreeVars))
-> HsForAllTelescope GhcRn -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ EpAnnForallTy -> [LHsTyVarBndr () GhcRn] -> HsForAllTelescope GhcRn
forall (p :: Pass).
EpAnnForallTy
-> [LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
mkHsForAllVisTele EpAnnForallTy
forall a. EpAnn 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 Any
-> [LHsTyVarBndr Specificity GhcPs]
-> ([LHsTyVarBndr Specificity GhcRn] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
WarnUnusedForalls Maybe Any
forall a. Maybe a
Nothing [LHsTyVarBndr Specificity GhcPs]
bndrs (([LHsTyVarBndr Specificity GhcRn] -> RnM (a, FreeVars))
 -> RnM (a, FreeVars))
-> ([LHsTyVarBndr Specificity GhcRn] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ \[LHsTyVarBndr Specificity GhcRn]
bndrs' ->
        HsForAllTelescope GhcRn -> RnM (a, FreeVars)
thing_inside (HsForAllTelescope GhcRn -> RnM (a, FreeVars))
-> HsForAllTelescope GhcRn -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ EpAnnForallTy
-> [LHsTyVarBndr Specificity GhcRn] -> HsForAllTelescope GhcRn
forall (p :: Pass).
EpAnnForallTy
-> [LHsTyVarBndr Specificity (GhcPass p)]
-> HsForAllTelescope (GhcPass p)
mkHsForAllInvisTele EpAnnForallTy
forall a. EpAnn a
noAnn [LHsTyVarBndr Specificity GhcRn]
bndrs'
data WarnUnusedForalls
  = WarnUnusedForalls
  | NoWarnUnusedForalls
instance Outputable WarnUnusedForalls where
  ppr :: WarnUnusedForalls -> SDoc
ppr WarnUnusedForalls
wuf = String -> SDoc
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               
                  -> [LHsTyVarBndr flag GhcPs]  
                  -> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars))
                  -> RnM (b, FreeVars)
bindLHsTyVarBndrs :: forall flag a b.
OutputableBndrFlag flag 'Renamed =>
HsDocContext
-> WarnUnusedForalls
-> Maybe a
-> [LHsTyVarBndr flag GhcPs]
-> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndrs HsDocContext
doc WarnUnusedForalls
wuf Maybe a
mb_assoc [LHsTyVarBndr flag GhcPs]
tv_bndrs [LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars)
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 ()
checkDupRdrNamesN FreeKiTyVars
tv_names_w_loc
       ; [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
    -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
go [LHsTyVarBndr flag GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
tv_bndrs [LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars)
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeVars)
thing_inside }
  where
    tv_names_w_loc :: FreeKiTyVars
tv_names_w_loc = (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
 -> GenLocated SrcSpanAnnN RdrName)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
-> FreeKiTyVars
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr flag GhcPs -> LocatedN (IdP GhcPs)
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> GenLocated SrcSpanAnnN RdrName
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> 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, FreeVars))
-> RnM (b, FreeVars)
go []     [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeVars)
thing_inside = [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeVars)
thing_inside []
    go (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
b:[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
bs) [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeVars)
thing_inside = HsDocContext
-> Maybe a
-> LHsTyVarBndr flag GhcPs
-> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
forall a flag b.
HsDocContext
-> Maybe a
-> LHsTyVarBndr flag GhcPs
-> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndr HsDocContext
doc Maybe a
mb_assoc LHsTyVarBndr flag GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
b ((LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars))
 -> RnM (b, FreeVars))
-> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ LHsTyVarBndr flag GhcRn
b' ->
                             do { (b
res, FreeVars
fvs) <- [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
    -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
go [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
bs (([GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
  -> RnM (b, FreeVars))
 -> RnM (b, FreeVars))
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
    -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
bs' ->
                                                [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> RnM (b, FreeVars)
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')
                                ; GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
-> FreeVars -> TcRn ()
warn_unused LHsTyVarBndr flag GhcRn
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
b' FreeVars
fvs
                                ; (b, FreeVars) -> RnM (b, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
res, FreeVars
fvs) }
    warn_unused :: GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
-> FreeVars -> TcRn ()
warn_unused GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
tv_bndr FreeVars
fvs = case WarnUnusedForalls
wuf of
      WarnUnusedForalls
WarnUnusedForalls   -> HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcRn ()
forall flag.
OutputableBndrFlag flag 'Renamed =>
HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcRn ()
warnUnusedForAll HsDocContext
doc LHsTyVarBndr flag GhcRn
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
tv_bndr FreeVars
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   
                 -> LHsTyVarBndr flag GhcPs
                 -> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars))
                 -> RnM (b, FreeVars)
bindLHsTyVarBndr :: forall a flag b.
HsDocContext
-> Maybe a
-> LHsTyVarBndr flag GhcPs
-> (LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndr HsDocContext
_doc Maybe a
mb_assoc (L SrcSpanAnnA
loc
                                 (UserTyVar XUserTyVar GhcPs
x flag
fl
                                    lrdr :: LIdP GhcPs
lrdr@(L SrcSpanAnnN
lv RdrName
_))) LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars)
thing_inside
  = do { Name
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
       ; [Name] -> RnM (b, FreeVars) -> RnM (b, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name
nm] (RnM (b, FreeVars) -> RnM (b, FreeVars))
-> RnM (b, FreeVars) -> RnM (b, FreeVars)
forall a b. (a -> b) -> a -> b
$
         LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars)
thing_inside (SrcSpanAnnA
-> HsTyVarBndr flag GhcRn
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XUserTyVar GhcRn -> flag -> LIdP GhcRn -> HsTyVarBndr flag GhcRn
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar XUserTyVar GhcPs
XUserTyVar GhcRn
x flag
fl (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
lv Name
nm))) }
bindLHsTyVarBndr HsDocContext
doc Maybe a
mb_assoc (L SrcSpanAnnA
loc (KindedTyVar XKindedTyVar GhcPs
x flag
fl lrdr :: LIdP GhcPs
lrdr@(L SrcSpanAnnN
lv RdrName
_) LHsType GhcPs
kind))
                 LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars)
thing_inside
  = do { Bool
sig_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.KindSignatures
           ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
sig_ok (HsDocContext -> LHsType GhcPs -> TcRn ()
badKindSigErr HsDocContext
doc LHsType GhcPs
kind)
           ; (GenLocated SrcSpanAnnA (HsType GhcRn)
kind', FreeVars
fvs1) <- HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsKind HsDocContext
doc LHsType GhcPs
kind
           ; Name
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
           ; (b
b, FreeVars
fvs2) <- [Name] -> RnM (b, FreeVars) -> RnM (b, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name
tv_nm]
               (RnM (b, FreeVars) -> RnM (b, FreeVars))
-> RnM (b, FreeVars) -> RnM (b, FreeVars)
forall a b. (a -> b) -> a -> b
$ LHsTyVarBndr flag GhcRn -> RnM (b, FreeVars)
thing_inside (SrcSpanAnnA
-> HsTyVarBndr flag GhcRn
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XKindedTyVar GhcRn
-> flag -> LIdP GhcRn -> LHsType GhcRn -> HsTyVarBndr flag GhcRn
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar XKindedTyVar GhcPs
XKindedTyVar GhcRn
x flag
fl (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
lv Name
tv_nm) LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
kind'))
           ; (b, FreeVars) -> RnM (b, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }
newTyVarNameRn :: Maybe a 
               -> LocatedN RdrName -> RnM Name
newTyVarNameRn :: forall a.
Maybe a
-> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn Maybe a
mb_assoc lrdr :: GenLocated SrcSpanAnnN RdrName
lrdr@(L SrcSpanAnnN
_ RdrName
rdr)
  = do { LocalRdrEnv
rdr_env <- RnM LocalRdrEnv
getLocalRdrEnv
       ; case (Maybe a
mb_assoc, LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv LocalRdrEnv
rdr_env RdrName
rdr) of
           (Just a
_, 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
              
           (Maybe a, Maybe Name)
_                -> GenLocated SrcSpanAnnN RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
newLocalBndrRn GenLocated SrcSpanAnnN RdrName
lrdr }
rnConDeclFields :: HsDocContext -> [FieldLabel] -> [LConDeclField GhcPs]
                -> RnM ([LConDeclField GhcRn], FreeVars)
rnConDeclFields :: HsDocContext
-> [FieldLabel]
-> [LConDeclField GhcPs]
-> RnM ([LConDeclField GhcRn], FreeVars)
rnConDeclFields HsDocContext
ctxt [FieldLabel]
fls [LConDeclField GhcPs]
fields
   = (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
 -> RnM (GenLocated SrcSpanAnnA (ConDeclField GhcRn), FreeVars))
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     ([GenLocated SrcSpanAnnA (ConDeclField GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (FastStringEnv FieldLabel
-> RnTyKiEnv
-> LConDeclField GhcPs
-> RnM (LConDeclField GhcRn, FreeVars)
rnField FastStringEnv FieldLabel
fl_env RnTyKiEnv
env) [LConDeclField GhcPs]
[GenLocated SrcSpanAnnA (ConDeclField 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 [ (FieldLabel -> FastString
flLabel FieldLabel
fl, FieldLabel
fl) | FieldLabel
fl <- [FieldLabel]
fls ]
rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField GhcPs
        -> RnM (LConDeclField GhcRn, FreeVars)
rnField :: FastStringEnv FieldLabel
-> RnTyKiEnv
-> LConDeclField GhcPs
-> RnM (LConDeclField GhcRn, FreeVars)
rnField FastStringEnv FieldLabel
fl_env RnTyKiEnv
env (L SrcSpanAnnA
l (ConDeclField XConDeclField GhcPs
_ [LFieldOcc GhcPs]
names LHsType GhcPs
ty Maybe (LHsDoc GhcPs)
haddock_doc))
  = do { (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> TcRn ())
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)] -> TcRn ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(L SrcAnn NoEpAnns
_ (FieldOcc XCFieldOcc GhcPs
_ XRec GhcPs RdrName
rdr_name)) -> GenLocated SrcSpanAnnN RdrName -> TcRn ()
warnForallIdentifier XRec GhcPs RdrName
GenLocated SrcSpanAnnN RdrName
rdr_name) [LFieldOcc GhcPs]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
names
       ; let new_names :: [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)]
new_names = (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
 -> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map ((FieldOcc GhcPs -> FieldOcc GhcRn)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
forall a b.
(a -> b)
-> GenLocated (SrcAnn NoEpAnns) a -> GenLocated (SrcAnn NoEpAnns) 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 (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
names
       ; (GenLocated SrcSpanAnnA (HsType GhcRn)
new_ty, FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; Maybe (LHsDoc GhcRn)
haddock_doc' <- (LHsDoc GhcPs -> RnM (LHsDoc GhcRn))
-> Maybe (LHsDoc GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsDoc 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) -> Maybe a -> f (Maybe b)
traverse LHsDoc GhcPs -> RnM (LHsDoc GhcRn)
rnLHsDoc Maybe (LHsDoc GhcPs)
haddock_doc
       ; (GenLocated SrcSpanAnnA (ConDeclField GhcRn), FreeVars)
-> RnM (GenLocated SrcSpanAnnA (ConDeclField GhcRn), FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> ConDeclField GhcRn
-> GenLocated SrcSpanAnnA (ConDeclField GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XConDeclField GhcRn
-> [LFieldOcc GhcRn]
-> LHsType GhcRn
-> Maybe (LHsDoc GhcRn)
-> ConDeclField GhcRn
forall pass.
XConDeclField pass
-> [LFieldOcc pass]
-> LBangType pass
-> Maybe (LHsDoc pass)
-> ConDeclField pass
ConDeclField XConDeclField GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LFieldOcc GhcRn]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)]
new_names LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
new_ty Maybe (LHsDoc GhcRn)
haddock_doc')
                , FreeVars
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 -> XRec GhcRn RdrName -> FieldOcc GhcRn
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc (FieldLabel -> Name
flSelector FieldLabel
fl) (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
lr RdrName
rdr)
  where
    lbl :: FastString
lbl = OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
rdr
    fl :: FieldLabel
fl  = String -> Maybe FieldLabel -> FieldLabel
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"lookupField" (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
mkHsOpTyRn :: PromotionFlag
           -> LocatedN Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn
           -> RnM (HsType GhcRn)
mkHsOpTyRn :: PromotionFlag
-> GenLocated SrcSpanAnnN Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> RnM (HsType GhcRn)
mkHsOpTyRn PromotionFlag
prom1 GenLocated SrcSpanAnnN Name
op1 Fixity
fix1 LHsType GhcRn
ty1 (L SrcSpanAnnA
loc2 (HsOpTy XOpTy GhcRn
_ PromotionFlag
prom2 LHsType GhcRn
ty2a LIdP GhcRn
op2 LHsType GhcRn
ty2b))
  = do  { Fixity
fix2 <- GenLocated SrcSpanAnnN Name -> RnM Fixity
lookupTyFixityRn LIdP GhcRn
GenLocated SrcSpanAnnN Name
op2
        ; PromotionFlag
-> GenLocated SrcSpanAnnN Name
-> Fixity
-> LHsType GhcRn
-> PromotionFlag
-> GenLocated SrcSpanAnnN Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> SrcSpanAnnA
-> RnM (HsType GhcRn)
mk_hs_op_ty PromotionFlag
prom1 GenLocated SrcSpanAnnN Name
op1 Fixity
fix1 LHsType GhcRn
ty1 PromotionFlag
prom2 LIdP GhcRn
GenLocated SrcSpanAnnN Name
op2 Fixity
fix2 LHsType GhcRn
ty2a LHsType GhcRn
ty2b SrcSpanAnnA
loc2 }
mkHsOpTyRn PromotionFlag
prom1 GenLocated SrcSpanAnnN Name
op1 Fixity
_ LHsType GhcRn
ty1 LHsType GhcRn
ty2              
  = HsType GhcRn -> RnM (HsType GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpTy GhcRn
-> PromotionFlag
-> LHsType GhcRn
-> LIdP GhcRn
-> LHsType GhcRn
-> HsType GhcRn
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy XOpTy GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
prom1 LHsType GhcRn
ty1 LIdP GhcRn
GenLocated SrcSpanAnnN Name
op1 LHsType GhcRn
ty2)
mk_hs_op_ty :: PromotionFlag -> LocatedN Name -> Fixity -> LHsType GhcRn
            -> PromotionFlag -> LocatedN Name -> Fixity -> LHsType GhcRn
            -> LHsType GhcRn -> SrcSpanAnnA
            -> RnM (HsType GhcRn)
mk_hs_op_ty :: PromotionFlag
-> GenLocated SrcSpanAnnN Name
-> Fixity
-> LHsType GhcRn
-> PromotionFlag
-> GenLocated SrcSpanAnnN Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> SrcSpanAnnA
-> RnM (HsType GhcRn)
mk_hs_op_ty PromotionFlag
prom1 GenLocated SrcSpanAnnN Name
op1 Fixity
fix1 LHsType GhcRn
ty1 PromotionFlag
prom2 GenLocated SrcSpanAnnN Name
op2 Fixity
fix2 LHsType GhcRn
ty2a LHsType GhcRn
ty2b SrcSpanAnnA
loc2
  | Bool
nofix_error     = do { (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (Name -> OpName
NormalOp (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN Name
op1),Fixity
fix1)
                                        (Name -> OpName
NormalOp (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN Name
op2),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 { 
                           HsType GhcRn
new_ty <- PromotionFlag
-> GenLocated SrcSpanAnnN Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> RnM (HsType GhcRn)
mkHsOpTyRn PromotionFlag
prom1 GenLocated SrcSpanAnnN Name
op1 Fixity
fix1 LHsType GhcRn
ty1 LHsType GhcRn
ty2a
                         ; HsType GhcRn -> RnM (HsType GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a an. a -> LocatedAn an a
noLocA HsType GhcRn
new_ty GenLocated SrcSpanAnnA (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
`op2ty` LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
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
-> PromotionFlag
-> LHsType GhcRn
-> LIdP GhcRn
-> LHsType GhcRn
-> HsType GhcRn
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy XOpTy GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
prom1 LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
lhs LIdP GhcRn
GenLocated SrcSpanAnnN Name
op1 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
-> PromotionFlag
-> LHsType GhcRn
-> LIdP GhcRn
-> LHsType GhcRn
-> HsType GhcRn
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy XOpTy GhcRn
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
prom2 LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
lhs LIdP GhcRn
GenLocated SrcSpanAnnN Name
op2 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             
          -> LHsExpr GhcRn -> Fixity   
          -> LHsExpr GhcRn             
                                       
          -> RnM (HsExpr GhcRn)
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,XOpApp GhcRn
Fixity
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 XOpApp GhcRn
Fixity
fix2 LHsExpr GhcRn
e1 LHsExpr GhcRn
op2 LHsExpr GhcRn
e2)
  | Bool
associate_right = do
    HsExpr GhcRn
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
    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 XOpApp GhcRn
fix1 LHsExpr GhcRn
e1a LHsExpr GhcRn
op1 (SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc' HsExpr GhcRn
new_e))
  where
    loc' :: SrcSpanAnnA
loc'= GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn 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 XOpApp GhcRn
Fixity
fix1 Fixity
fix2
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 XOpApp GhcRn
Fixity
fix2 LHsExpr GhcRn
e1 LHsExpr GhcRn
op2 LHsExpr GhcRn
e2)
  | Bool
associate_right
  = do HsExpr GhcRn
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
       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 (SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc' HsExpr GhcRn
new_e) SyntaxExpr GhcRn
neg_name)
  where
    loc' :: SrcSpanAnnA
loc' = GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SrcSpanAnnA
forall a e1 e2.
Semigroup a =>
GenLocated (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn 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
mkOpAppRn NegationHandling
ReassociateNegation LHsExpr GhcRn
e1 LHsExpr GhcRn
op1 Fixity
fix1 e2 :: LHsExpr GhcRn
e2@(L SrcSpanAnnA
_ (NegApp {})) 
  | Bool -> Bool
not Bool
associate_right                        
  = 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 XOpApp GhcRn
Fixity
fix1 LHsExpr GhcRn
e1 LHsExpr GhcRn
op1 LHsExpr GhcRn
e2)
  where
    (Bool
_, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
negateFixity
mkOpAppRn NegationHandling
_ LHsExpr GhcRn
e1 LHsExpr GhcRn
op Fixity
fix LHsExpr GhcRn
e2                  
  = 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
$$ String -> SDoc
text String
"---" SDoc -> SDoc -> SDoc
$$ GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"---" SDoc -> SDoc -> SDoc
$$ Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fix SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"---" SDoc -> SDoc -> SDoc
$$ 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 XOpApp GhcRn
Fixity
fix LHsExpr GhcRn
e1 LHsExpr GhcRn
op LHsExpr GhcRn
e2)
data NegationHandling = ReassociateNegation | KeepNegationIntact
data OpName = NormalOp Name             
            | NegateOp                  
            | UnboundOp OccName         
            | RecFldOp (FieldOcc GhcRn) 
instance Outputable OpName where
  ppr :: OpName -> SDoc
ppr (NormalOp Name
n)   = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
  ppr OpName
NegateOp       = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
negateName
  ppr (UnboundOp OccName
uv) = OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
uv
  ppr (RecFldOp FieldOcc GhcRn
fld) = FieldOcc GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldOcc GhcRn
fld
get_op :: LHsExpr GhcRn -> OpName
get_op :: LHsExpr GhcRn -> OpName
get_op (L SrcSpanAnnA
_ (HsVar XVar GhcRn
_ LIdP GhcRn
n))         = Name -> OpName
NormalOp (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
n)
get_op (L SrcSpanAnnA
_ (HsUnboundVar XUnboundVar GhcRn
_ OccName
uv)) = OccName -> OpName
UnboundOp OccName
uv
get_op (L SrcSpanAnnA
_ (HsRecSel XRecSel GhcRn
_ 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)
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 XOpApp GhcRn
Fixity
fix2
right_op_ok Fixity
_ HsExpr GhcRn
_
  = Bool
True
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
mkOpFormRn :: LHsCmdTop GhcRn            
          -> LHsExpr GhcRn -> Fixity     
          -> LHsCmdTop GhcRn             
          -> RnM (HsCmd GhcRn)
mkOpFormRn :: LHsCmdTop GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsCmdTop GhcRn -> RnM (HsCmd GhcRn)
mkOpFormRn e1 :: LHsCmdTop GhcRn
e1@(L SrcAnn NoEpAnns
loc
                    (HsCmdTop XCmdTop GhcRn
_
                     (L SrcSpanAnnA
_ (HsCmdArrForm XCmdArrForm GhcRn
x LHsExpr GhcRn
op1 LexicalFixity
f (Just Fixity
fix1)
                        [LHsCmdTop GhcRn
e1a,LHsCmdTop GhcRn
e1b]))))
        LHsExpr GhcRn
op2 Fixity
fix2 LHsCmdTop GhcRn
e2
  | Bool
nofix_error
  = do (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op1,Fixity
fix1) (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op2,Fixity
fix2)
       HsCmd GhcRn -> RnM (HsCmd GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrForm GhcRn
-> LHsExpr GhcRn
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcRn]
-> HsCmd GhcRn
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm XCmdArrForm GhcRn
x LHsExpr GhcRn
op2 LexicalFixity
f (Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just Fixity
fix2) [LHsCmdTop GhcRn
e1, LHsCmdTop GhcRn
e2])
  | Bool
associate_right
  = do HsCmd GhcRn
new_c <- LHsCmdTop GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsCmdTop GhcRn -> RnM (HsCmd GhcRn)
mkOpFormRn LHsCmdTop GhcRn
e1a LHsExpr GhcRn
op2 Fixity
fix2 LHsCmdTop GhcRn
e2
       HsCmd GhcRn -> RnM (HsCmd GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrForm GhcRn
-> LHsExpr GhcRn
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcRn]
-> HsCmd GhcRn
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm XCmdArrForm GhcRn
NoExtField
noExtField LHsExpr GhcRn
op1 LexicalFixity
f (Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just Fixity
fix1)
               [LHsCmdTop GhcRn
e1b, SrcAnn NoEpAnns
-> HsCmdTop GhcRn -> GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
loc (XCmdTop GhcRn -> LHsCmd GhcRn -> HsCmdTop GhcRn
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop [] (SrcSpanAnnA -> HsCmd GhcRn -> GenLocated SrcSpanAnnA (HsCmd GhcRn)
forall l e. l -> e -> GenLocated l e
L (SrcAnn NoEpAnns -> SrcSpanAnnA
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcAnn NoEpAnns
loc) HsCmd GhcRn
new_c))])
        
  where
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2
mkOpFormRn LHsCmdTop GhcRn
arg1 LHsExpr GhcRn
op Fixity
fix LHsCmdTop GhcRn
arg2                     
  = HsCmd GhcRn -> RnM (HsCmd GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrForm GhcRn
-> LHsExpr GhcRn
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcRn]
-> HsCmd GhcRn
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm XCmdArrForm GhcRn
NoExtField
noExtField LHsExpr GhcRn
op LexicalFixity
Infix (Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just Fixity
fix) [LHsCmdTop GhcRn
arg1, LHsCmdTop GhcRn
arg2])
mkConOpPatRn :: LocatedN Name -> Fixity -> LPat GhcRn -> LPat GhcRn
             -> RnM (Pat GhcRn)
mkConOpPatRn :: GenLocated SrcSpanAnnN Name
-> Fixity -> LPat GhcRn -> LPat GhcRn -> RnM (Pat GhcRn)
mkConOpPatRn GenLocated SrcSpanAnnN 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  { Fixity
fix1 <- Name -> RnM Fixity
lookupFixityRn (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN Name
op1)
        ; let (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2
        ; if Bool
nofix_error then do
                { (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (Name -> OpName
NormalOp (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN Name
op1),Fixity
fix1)
                               (Name -> OpName
NormalOp (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN Name
op2),Fixity
fix2)
                ; 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 Name
op2
                    , pat_args :: HsConDetails
  (HsPatSigType (NoGhcTc GhcRn))
  (LPat GhcRn)
  (HsRecFields GhcRn (LPat GhcRn))
pat_args = GenLocated SrcSpanAnnA (Pat GhcRn)
-> GenLocated SrcSpanAnnA (Pat GhcRn)
-> HsConDetails
     (HsPatSigType GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcRn))
     (HsRecFields GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
p1 LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
p2
                    }
                }
          else if Bool
associate_right then do
                { Pat GhcRn
new_p <- GenLocated SrcSpanAnnN Name
-> Fixity -> LPat GhcRn -> LPat GhcRn -> RnM (Pat GhcRn)
mkConOpPatRn GenLocated SrcSpanAnnN Name
op2 Fixity
fix2 LPat GhcRn
p1b LPat GhcRn
p2
                ; 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)
op1
                    , pat_args :: HsConDetails
  (HsPatSigType (NoGhcTc GhcRn))
  (LPat GhcRn)
  (HsRecFields GhcRn (LPat GhcRn))
pat_args = GenLocated SrcSpanAnnA (Pat GhcRn)
-> GenLocated SrcSpanAnnA (Pat GhcRn)
-> HsConDetails
     (HsPatSigType GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcRn))
     (HsRecFields GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
p1a (SrcSpanAnnA -> Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc Pat GhcRn
new_p)
                    }
                }
                
          else 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 Name
op2
                 , pat_args :: HsConDetails
  (HsPatSigType (NoGhcTc GhcRn))
  (LPat GhcRn)
  (HsRecFields GhcRn (LPat GhcRn))
pat_args = GenLocated SrcSpanAnnA (Pat GhcRn)
-> GenLocated SrcSpanAnnA (Pat GhcRn)
-> HsConDetails
     (HsPatSigType GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcRn))
     (HsRecFields GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
p1 LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
p2
                 }
        }
mkConOpPatRn GenLocated SrcSpanAnnN Name
op Fixity
_ LPat GhcRn
p1 LPat GhcRn
p2                         
  = 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 Name
op
      , pat_args :: HsConDetails
  (HsPatSigType (NoGhcTc GhcRn))
  (LPat GhcRn)
  (HsRecFields GhcRn (LPat GhcRn))
pat_args = GenLocated SrcSpanAnnA (Pat GhcRn)
-> GenLocated SrcSpanAnnA (Pat GhcRn)
-> HsConDetails
     (HsPatSigType GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcRn))
     (HsRecFields GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg 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 ()
  
  
  
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 -> [LPat p]
m_pats = (L SrcSpanAnnA
l1 Pat GhcRn
p1)
                               : (L SrcSpanAnnA
l2 Pat GhcRn
p2)
                               : [LPat GhcRn]
_ }))
      = SrcSpan -> TcRn () -> TcRn ()
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (SrcSpanAnnA -> SrcSpan) -> SrcSpanAnnA -> SrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn 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 ()
        
        
        
        
        
        
        
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_fix@(Fixity SourceText
_ Int
op_prec  FixityDirection
op_dir) <- Name -> RnM Fixity
lookupFixityRn Name
op
    op1_fix :: Fixity
op1_fix@(Fixity SourceText
_ Int
op1_prec FixityDirection
op1_dir) <- Name -> RnM Fixity
lookupFixityRn (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN Name
op1)
    let
        inf_ok :: Bool
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 :: (OpName, Fixity)
info  = (Name -> OpName
NormalOp Name
op,          Fixity
op_fix)
        info1 :: (OpName, Fixity)
info1 = (Name -> OpName
NormalOp (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN Name
op1), Fixity
op1_fix)
        ((OpName, Fixity)
infol, (OpName, Fixity)
infor) = if Bool
right then ((OpName, Fixity)
info, (OpName, Fixity)
info1) else ((OpName, Fixity)
info1, (OpName, Fixity)
info)
    Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
inf_ok ((OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (OpName, Fixity)
infol (OpName, Fixity)
infor)
checkPrec Name
_ Pat GhcRn
_ Bool
_
  = () -> TcRn ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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') XOpApp GhcRn
Fixity
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 SourceText
_ Int
arg_prec FixityDirection
assoc) = do
          op_fix :: Fixity
op_fix@(Fixity SourceText
_ Int
op_prec FixityDirection
_) <- OpName -> RnM Fixity
lookupFixityOp OpName
op_name
          Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
op_prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arg_prec
                  Bool -> Bool -> Bool
|| (Int
op_prec Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arg_prec Bool -> Bool -> Bool
&& FixityDirection
direction FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
assoc))
                 ((OpName, Fixity) -> (OpName, Fixity) -> HsExpr GhcPs -> TcRn ()
sectionPrecErr (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op, Fixity
op_fix)
                                 (OpName
arg_op, Fixity
arg_fix) HsExpr GhcPs
section)
lookupFixityOp :: OpName -> RnM Fixity
lookupFixityOp :: OpName -> RnM Fixity
lookupFixityOp (NormalOp Name
n)  = Name -> RnM Fixity
lookupFixityRn Name
n
lookupFixityOp OpName
NegateOp      = Name -> RnM Fixity
lookupFixityRn Name
negateName
lookupFixityOp (UnboundOp OccName
u) = Name -> RnM Fixity
lookupFixityRn (OccName -> Name
mkUnboundName OccName
u)
lookupFixityOp (RecFldOp FieldOcc GhcRn
f)  = FieldOcc GhcRn -> RnM Fixity
lookupFieldFixityRn FieldOcc GhcRn
f
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 ()     
  | Bool
otherwise
  = TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
      SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Precedence parsing error")
      Int
4 ([SDoc] -> SDoc
hsep [String -> SDoc
text String
"cannot mix", (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
op1, String -> SDoc
text String
"and",
               (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
op2,
               String -> SDoc
text String
"in the same infix expression"])
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 ()     
  | Bool
otherwise
  = TcRnMessage -> TcRn ()
addErr (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
vcat [String -> SDoc
text String
"The operator" SDoc -> SDoc -> SDoc
<+> (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
op SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"of a section",
         Int -> SDoc -> SDoc
nest Int
4 ([SDoc] -> SDoc
sep [String -> SDoc
text String
"must have lower precedence than that of the operand,",
                      Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"namely" SDoc -> SDoc -> SDoc
<+> (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
arg_op)]),
         Int -> SDoc -> SDoc
nest Int
4 (String -> SDoc
text String
"in the section:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
section))]
is_unbound :: OpName -> Bool
is_unbound :: OpName -> Bool
is_unbound (NormalOp Name
n) = Name -> Bool
isUnboundName Name
n
is_unbound UnboundOp{}  = Bool
True
is_unbound OpName
_            = Bool
False
ppr_opfix :: (OpName, Fixity) -> SDoc
ppr_opfix :: (OpName, Fixity) -> SDoc
ppr_opfix (OpName
op, Fixity
fixity) = SDoc
pp_op SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
brackets (Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fixity)
   where
     pp_op :: SDoc
pp_op | OpName
NegateOp <- OpName
op = String -> SDoc
text String
"prefix `-'"
           | Bool
otherwise      = SDoc -> SDoc
quotes (OpName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OpName
op)
unexpectedPatSigTypeErr :: HsPatSigType GhcPs -> TcRnMessage
unexpectedPatSigTypeErr :: HsPatSigType GhcPs -> TcRnMessage
unexpectedPatSigTypeErr HsPatSigType GhcPs
ty
  = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
    SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Illegal type signature:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (HsPatSigType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPatSigType GhcPs
ty))
       Int
2 (String -> SDoc
text String
"Type signatures are only allowed in patterns with ScopedTypeVariables")
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. SrcSpanAnn' 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
$ DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
    HsDocContext -> SDoc -> SDoc
withHsDocContext HsDocContext
doc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Illegal kind signature:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
ty))
       Int
2 (String -> SDoc
text String
"Perhaps you intended to use KindSignatures")
dataKindsErr :: RnTyKiEnv -> HsType GhcPs -> TcRnMessage
dataKindsErr :: RnTyKiEnv -> HsType GhcPs -> TcRnMessage
dataKindsErr RnTyKiEnv
env HsType GhcPs
thing
  = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
    SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Illegal" SDoc -> SDoc -> SDoc
<+> SDoc
pp_what SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
thing))
       Int
2 (String -> SDoc
text String
"Perhaps you intended to use DataKinds")
  where
    pp_what :: SDoc
pp_what | RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env = String -> SDoc
text String
"kind"
            | Bool
otherwise          = String -> SDoc
text String
"type"
warnUnusedForAll :: OutputableBndrFlag flag 'Renamed
                 => HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcM ()
warnUnusedForAll :: forall flag.
OutputableBndrFlag flag 'Renamed =>
HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcRn ()
warnUnusedForAll HsDocContext
doc (L SrcSpanAnnA
loc HsTyVarBndr flag GhcRn
tv) FreeVars
used_names
  = Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsTyVarBndr flag GhcRn -> IdP GhcRn
forall flag (p :: Pass).
HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsTyVarName HsTyVarBndr flag GhcRn
tv Name -> FreeVars -> Bool
`elemNameSet` FreeVars
used_names) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ do
      let msg :: TcRnMessage
msg = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
            DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnusedForalls) [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
              [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Unused quantified type variable" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (HsTyVarBndr flag GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyVarBndr flag GhcRn
tv)
                   , HsDocContext -> SDoc
inHsDocContext HsDocContext
doc ]
      SrcSpan -> TcRnMessage -> TcRn ()
addDiagnosticAt (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) TcRnMessage
msg
type FreeKiTyVars = [LocatedN RdrName]
filterInScope :: LocalRdrEnv -> FreeKiTyVars -> FreeKiTyVars
filterInScope :: LocalRdrEnv -> FreeKiTyVars -> FreeKiTyVars
filterInScope LocalRdrEnv
rdr_env = (GenLocated SrcSpanAnnN RdrName -> Bool)
-> FreeKiTyVars -> FreeKiTyVars
forall a. (a -> Bool) -> [a] -> [a]
filterOut (LocalRdrEnv -> RdrName -> Bool
inScope LocalRdrEnv
rdr_env (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)
filterInScopeM :: FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM :: FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM FreeKiTyVars
vars
  = do { LocalRdrEnv
rdr_env <- RnM LocalRdrEnv
getLocalRdrEnv
       ; FreeKiTyVars -> RnM FreeKiTyVars
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalRdrEnv -> FreeKiTyVars -> FreeKiTyVars
filterInScope LocalRdrEnv
rdr_env FreeKiTyVars
vars) }
inScope :: LocalRdrEnv -> RdrName -> Bool
inScope :: LocalRdrEnv -> RdrName -> Bool
inScope LocalRdrEnv
rdr_env RdrName
rdr = RdrName
rdr RdrName -> LocalRdrEnv -> Bool
`elemLocalRdrEnv` LocalRdrEnv
rdr_env
extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVars -> FreeKiTyVars
 (HsValArg LHsType GhcPs
ty) FreeKiTyVars
acc = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty FreeKiTyVars
acc
extract_tyarg (HsTypeArg SrcSpan
_ LHsType GhcPs
ki) FreeKiTyVars
acc = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ki FreeKiTyVars
acc
extract_tyarg (HsArgPar SrcSpan
_) FreeKiTyVars
acc = FreeKiTyVars
acc
extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVars -> FreeKiTyVars
 [LHsTypeArg GhcPs]
args FreeKiTyVars
acc = (HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> FreeKiTyVars -> FreeKiTyVars)
-> FreeKiTyVars
-> [HsArg
      (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
  (GenLocated SrcSpanAnnA (HsType GhcPs))
  (GenLocated SrcSpanAnnA (HsType GhcPs))
-> FreeKiTyVars -> FreeKiTyVars
extract_tyarg FreeKiTyVars
acc [LHsTypeArg GhcPs]
[HsArg
   (GenLocated SrcSpanAnnA (HsType GhcPs))
   (GenLocated SrcSpanAnnA (HsType GhcPs))]
args
extractHsTyArgRdrKiTyVars :: [LHsTypeArg GhcPs] -> FreeKiTyVars
 [LHsTypeArg GhcPs]
args
  = [LHsTypeArg GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_tyargs [LHsTypeArg GhcPs]
args []
extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVars
 LHsType GhcPs
ty = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty []
extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVars
 (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
_ -> []
extractHsTysRdrTyVars :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars
 HsContext GhcPs
tys = HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys HsContext GhcPs
tys
extractHsTyVarBndrsKVs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
 [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
extractRdrKindSigVars :: LFamilyResultSig GhcPs -> FreeKiTyVars
 (L SrcAnn NoEpAnns
_ 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
_ (KindedTyVar XKindedTyVar GhcPs
_ ()
_ LIdP GhcPs
_ LHsType GhcPs
k)) -> LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars LHsType GhcPs
k
  FamilyResultSig GhcPs
_ -> []
extractConDeclGADTDetailsTyVars ::
  HsConDeclGADTDetails GhcPs -> FreeKiTyVars -> FreeKiTyVars
 HsConDeclGADTDetails GhcPs
con_args = case HsConDeclGADTDetails GhcPs
con_args of
  PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
args      -> [HsScaled GhcPs (LHsType GhcPs)] -> FreeKiTyVars -> FreeKiTyVars
extract_scaled_ltys [HsScaled GhcPs (LHsType GhcPs)]
args
  RecConGADT (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds) LHsUniToken "->" "\8594" GhcPs
_ -> HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys (HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars)
-> HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> LHsType GhcPs)
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> HsContext GhcPs
forall a b. (a -> b) -> [a] -> [b]
map (ConDeclField GhcPs -> LHsType GhcPs
ConDeclField GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type (ConDeclField GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
    -> ConDeclField GhcPs)
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> ConDeclField GhcPs
forall l e. GenLocated l e -> e
unLoc) ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> HsContext GhcPs)
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)] -> HsContext GhcPs
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds
extractDataDefnKindVars :: HsDataDefn GhcPs ->  FreeKiTyVars
 (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
 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 :: [HsScaled GhcPs (LHsType GhcPs)]
                    -> FreeKiTyVars -> FreeKiTyVars
 [HsScaled GhcPs (LHsType GhcPs)]
args FreeKiTyVars
acc = (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> FreeKiTyVars -> FreeKiTyVars)
-> FreeKiTyVars
-> [HsScaled 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 HsScaled GhcPs (LHsType GhcPs) -> FreeKiTyVars -> FreeKiTyVars
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> FreeKiTyVars -> FreeKiTyVars
extract_scaled_lty FreeKiTyVars
acc [HsScaled GhcPs (LHsType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
args
extract_scaled_lty :: HsScaled GhcPs (LHsType GhcPs)
                   -> FreeKiTyVars -> FreeKiTyVars
 (HsScaled HsArrow GhcPs
m LHsType GhcPs
ty) FreeKiTyVars
acc = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$ HsArrow GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_hs_arrow HsArrow GhcPs
m FreeKiTyVars
acc
extract_ltys :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars
 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
 (L SrcSpanAnnA
_ HsType GhcPs
ty) FreeKiTyVars
acc
  = case HsType GhcPs
ty of
      HsTyVar XTyVar GhcPs
_ PromotionFlag
_  LIdP GhcPs
ltv            -> GenLocated SrcSpanAnnN RdrName -> FreeKiTyVars -> FreeKiTyVars
extract_tv LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
ltv FreeKiTyVars
acc
      HsBangTy XBangTy GhcPs
_ HsSrcBang
_ LHsType GhcPs
ty             -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty FreeKiTyVars
acc
      HsRecTy XRecTy GhcPs
_ [LConDeclField GhcPs]
flds              -> (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
 -> FreeKiTyVars -> FreeKiTyVars)
-> FreeKiTyVars
-> [GenLocated SrcSpanAnnA (ConDeclField 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
                                            (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> FreeKiTyVars -> FreeKiTyVars)
-> (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
    -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> FreeKiTyVars
-> FreeKiTyVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConDeclField GhcPs -> LHsType GhcPs
ConDeclField GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type (ConDeclField GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
    -> ConDeclField GhcPs)
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> ConDeclField GhcPs
forall l e. GenLocated l e -> e
unLoc) FreeKiTyVars
acc
                                           [LConDeclField GhcPs]
[GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds
      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
_ HsArrow GhcPs
w 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 -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
                                     HsArrow GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_hs_arrow HsArrow GhcPs
w 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
_ PromotionFlag
_ LHsType GhcPs
ty1 LIdP GhcPs
tv LHsType GhcPs
ty2       -> GenLocated SrcSpanAnnN RdrName -> FreeKiTyVars -> FreeKiTyVars
extract_tv LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tv (FreeKiTyVars -> FreeKiTyVars) -> FreeKiTyVars -> FreeKiTyVars
forall a b. (a -> b) -> a -> b
$
                                     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
      HsParTy XParTy GhcPs
_ LHsType GhcPs
ty                -> LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
ty FreeKiTyVars
acc
      HsSpliceTy {}               -> FreeKiTyVars
acc  
      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
_ HsContext GhcPs
tys     -> HsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_ltys HsContext GhcPs
tys FreeKiTyVars
acc
      HsTyLit XTyLit GhcPs
_ HsTyLit
_                 -> FreeKiTyVars
acc
      HsStarTy XStarTy GhcPs
_ Bool
_                -> FreeKiTyVars
acc
      HsKindSig XKindSig GhcPs
_ LHsType GhcPs
ty LHsType GhcPs
ki           -> 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
      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
      
      HsWildCardTy {}             -> FreeKiTyVars
acc
extract_lhs_sig_ty :: LHsSigType GhcPs -> FreeKiTyVars
 (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_arrow :: HsArrow GhcPs -> FreeKiTyVars ->
                   FreeKiTyVars
 (HsExplicitMult LHsToken "%" GhcPs
_ LHsType GhcPs
p LHsUniToken "->" "\8594" GhcPs
_) FreeKiTyVars
acc = LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty LHsType GhcPs
p FreeKiTyVars
acc
extract_hs_arrow HsArrow GhcPs
_ FreeKiTyVars
acc = FreeKiTyVars
acc
extract_hs_for_all_telescope :: HsForAllTelescope GhcPs
                             -> FreeKiTyVars 
                             -> FreeKiTyVars 
                             -> FreeKiTyVars
 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 
                      -> FreeKiTyVars 
 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
extract_hs_tv_bndrs :: [LHsTyVarBndr flag GhcPs]
                    -> FreeKiTyVars  
                    -> FreeKiTyVars  
                    -> FreeKiTyVars
 [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
filterFreeVarsToBind 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
    
    
    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)
 -> GenLocated SrcSpanAnnN RdrName)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
-> FreeKiTyVars
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr flag GhcPs -> LocatedN (IdP GhcPs)
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> GenLocated SrcSpanAnnN RdrName
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
hsLTyVarLocName [LHsTyVarBndr flag GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
tv_bndrs
extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars
 [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
_ (KindedTyVar XKindedTyVar GhcPs
_ flag
_ LIdP GhcPs
_ LHsType GhcPs
k) <- [LHsTyVarBndr flag GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)]
tv_bndrs]
extract_tv :: LocatedN RdrName -> FreeKiTyVars -> FreeKiTyVars
 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) then GenLocated SrcSpanAnnN RdrName
tvGenLocated SrcSpanAnnN RdrName -> FreeKiTyVars -> FreeKiTyVars
forall a. a -> [a] -> [a]
:FreeKiTyVars
acc else FreeKiTyVars
acc
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
filterFreeVarsToBind :: FreeKiTyVars
                     
                     -> FreeKiTyVars
                     
                     -> FreeKiTyVars
                     
filterFreeVarsToBind :: FreeKiTyVars -> FreeKiTyVars -> FreeKiTyVars
filterFreeVarsToBind FreeKiTyVars
bndrs = (GenLocated SrcSpanAnnN RdrName -> Bool)
-> FreeKiTyVars -> FreeKiTyVars
forall a. (a -> Bool) -> [a] -> [a]
filterOut GenLocated SrcSpanAnnN RdrName -> Bool
is_in_scope
    
    
  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