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

\section[RnSource]{Main pass of renamer}
-}

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}

module RnTypes (
        -- Type related stuff
        rnHsType, rnLHsType, rnLHsTypes, rnContext,
        rnHsKind, rnLHsKind, rnLHsTypeArgs,
        rnHsSigType, rnHsWcType,
        HsSigWcTypeScoping(..), rnHsSigWcType, rnHsSigWcTypeScoped,
        newTyVarNameRn,
        rnConDeclFields,
        rnLTyVar,

        -- Precence related stuff
        mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
        checkPrecMatch, checkSectionPrec,

        -- Binding related stuff
        bindLHsTyVarBndr, bindLHsTyVarBndrs, rnImplicitBndrs,
        bindSigTyVarsFV, bindHsQTyVars, bindLRdrNames,
        extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
        extractHsTysRdrTyVarsDups,
        extractRdrKindSigVars, extractDataDefnKindVars,
        extractHsTvBndrs, extractHsTyArgRdrKiTyVarsDup,
        nubL, elemRdr
  ) where

import GhcPrelude

import {-# SOURCE #-} RnSplice( rnSpliceType )

import DynFlags
import GHC.Hs
import RnHsDoc          ( rnLHsDoc, rnMbLHsDoc )
import RnEnv
import RnUtils          ( HsDocContext(..), withHsDocContext, mapFvRn
                        , pprHsDocContext, bindLocalNamesFV, typeAppErr
                        , newLocalBndrRn, checkDupRdrNames, checkShadowedRdrNames )
import RnFixity         ( lookupFieldFixityRn, lookupFixityRn
                        , lookupTyFixityRn )
import TcRnMonad
import RdrName
import PrelNames
import TysPrim          ( funTyConName )
import Name
import SrcLoc
import NameSet
import FieldLabel

import Util
import ListSetOps       ( deleteBys )
import BasicTypes       ( compareFixity, funTyFixity, negateFixity
                        , Fixity(..), FixityDirection(..), LexicalFixity(..)
                        , TypeOrKind(..) )
import Outputable
import FastString
import Maybes
import qualified GHC.LanguageExtensions as LangExt

import Data.List          ( nubBy, partition, (\\) )
import Control.Monad      ( unless, when )

#include "HsVersions.h"

{-
These type renamers are in a separate module, rather than in (say) RnSource,
to break several loop.

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

data HsSigWcTypeScoping = AlwaysBind
                          -- ^ Always bind any free tyvars of the given type,
                          --   regardless of whether we have a forall at the top
                        | BindUnlessForall
                          -- ^ Unless there's forall at the top, do the same
                          --   thing as 'AlwaysBind'
                        | NeverBind
                          -- ^ Never bind any free tyvars

rnHsSigWcType :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs
              -> RnM (LHsSigWcType GhcRn, FreeVars)
rnHsSigWcType :: HsSigWcTypeScoping
-> HsDocContext
-> LHsSigWcType GhcPs
-> RnM (LHsSigWcType GhcRn, FreeVars)
rnHsSigWcType HsSigWcTypeScoping
scoping HsDocContext
doc LHsSigWcType GhcPs
sig_ty
  = HsSigWcTypeScoping
-> HsDocContext
-> LHsSigWcType GhcPs
-> (LHsSigWcType GhcRn -> RnM (LHsSigWcType GhcRn, FreeVars))
-> RnM (LHsSigWcType GhcRn, FreeVars)
forall a.
HsSigWcTypeScoping
-> HsDocContext
-> LHsSigWcType GhcPs
-> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rn_hs_sig_wc_type HsSigWcTypeScoping
scoping HsDocContext
doc LHsSigWcType GhcPs
sig_ty ((LHsSigWcType GhcRn -> RnM (LHsSigWcType GhcRn, FreeVars))
 -> RnM (LHsSigWcType GhcRn, FreeVars))
-> (LHsSigWcType GhcRn -> RnM (LHsSigWcType GhcRn, FreeVars))
-> RnM (LHsSigWcType GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \LHsSigWcType GhcRn
sig_ty' ->
    (LHsSigWcType GhcRn, FreeVars)
-> RnM (LHsSigWcType GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsSigWcType GhcRn
sig_ty', FreeVars
emptyFVs)

rnHsSigWcTypeScoped :: HsSigWcTypeScoping
                       -- AlwaysBind: for pattern type sigs and rules we /do/ want
                       --             to bring those type variables into scope, even
                       --             if there's a forall at the top which usually
                       --             stops that happening
                       -- e.g  \ (x :: forall a. a-> b) -> e
                       -- Here we do bring 'b' into scope
                    -> HsDocContext -> LHsSigWcType GhcPs
                    -> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
                    -> RnM (a, FreeVars)
-- Used for
--   - Signatures on binders in a RULE
--   - Pattern type signatures
-- Wildcards are allowed
-- type signatures on binders only allowed with ScopedTypeVariables
rnHsSigWcTypeScoped :: HsSigWcTypeScoping
-> HsDocContext
-> LHsSigWcType GhcPs
-> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnHsSigWcTypeScoped HsSigWcTypeScoping
scoping HsDocContext
ctx LHsSigWcType GhcPs
sig_ty LHsSigWcType 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 -> MsgDoc -> TcRn ()
checkErr Bool
ty_sig_okay (LHsSigWcType GhcPs -> MsgDoc
unexpectedTypeSigErr LHsSigWcType GhcPs
sig_ty)
       ; HsSigWcTypeScoping
-> HsDocContext
-> LHsSigWcType GhcPs
-> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall a.
HsSigWcTypeScoping
-> HsDocContext
-> LHsSigWcType GhcPs
-> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rn_hs_sig_wc_type HsSigWcTypeScoping
scoping HsDocContext
ctx LHsSigWcType GhcPs
sig_ty LHsSigWcType GhcRn -> RnM (a, FreeVars)
thing_inside
       }

rn_hs_sig_wc_type :: HsSigWcTypeScoping -> HsDocContext -> LHsSigWcType GhcPs
                  -> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
                  -> RnM (a, FreeVars)
-- rn_hs_sig_wc_type is used for source-language type signatures
rn_hs_sig_wc_type :: HsSigWcTypeScoping
-> HsDocContext
-> LHsSigWcType GhcPs
-> (LHsSigWcType GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rn_hs_sig_wc_type HsSigWcTypeScoping
scoping HsDocContext
ctxt
                  (HsWC { hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcPs
hs_ty }})
                  LHsSigWcType GhcRn -> RnM (a, FreeVars)
thing_inside
  = do { FreeKiTyVarsWithDups
free_vars <- LHsType GhcPs -> RnM FreeKiTyVarsWithDups
extractFilteredRdrTyVarsDups LHsType GhcPs
hs_ty
       ; (FreeKiTyVarsWithDups
nwc_rdrs', FreeKiTyVarsWithDups
tv_rdrs) <- FreeKiTyVarsWithDups
-> RnM (FreeKiTyVarsWithDups, FreeKiTyVarsWithDups)
partition_nwcs FreeKiTyVarsWithDups
free_vars
       ; let nwc_rdrs :: FreeKiTyVarsWithDups
nwc_rdrs = FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. Eq a => [Located a] -> [Located a]
nubL FreeKiTyVarsWithDups
nwc_rdrs'
             bind_free_tvs :: Bool
bind_free_tvs = case HsSigWcTypeScoping
scoping of
                               HsSigWcTypeScoping
AlwaysBind       -> Bool
True
                               HsSigWcTypeScoping
BindUnlessForall -> Bool -> Bool
not (LHsType GhcPs -> Bool
forall p. LHsType p -> Bool
isLHsForAllTy LHsType GhcPs
hs_ty)
                               HsSigWcTypeScoping
NeverBind        -> Bool
False
       ; Bool
-> FreeKiTyVarsWithDups
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall a.
Bool
-> FreeKiTyVarsWithDups
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnImplicitBndrs Bool
bind_free_tvs FreeKiTyVarsWithDups
tv_rdrs (([Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars))
-> ([Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
vars ->
    do { ([Name]
wcs, LHsType GhcRn
hs_ty', FreeVars
fvs1) <- HsDocContext
-> FreeKiTyVarsWithDups
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody HsDocContext
ctxt FreeKiTyVarsWithDups
nwc_rdrs LHsType GhcPs
hs_ty
       ; let sig_ty' :: LHsSigWcType GhcRn
sig_ty' = HsWC :: forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC { hswc_ext :: XHsWC GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
hswc_ext = [Name]
XHsWC GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
wcs, hswc_body :: HsImplicitBndrs GhcRn (LHsType GhcRn)
hswc_body = HsImplicitBndrs GhcRn (LHsType GhcRn)
ib_ty' }
             ib_ty' :: HsImplicitBndrs GhcRn (LHsType GhcRn)
ib_ty'  = HsIB :: forall pass thing.
XHsIB pass thing -> thing -> HsImplicitBndrs pass thing
HsIB { hsib_ext :: XHsIB GhcRn (LHsType GhcRn)
hsib_ext = [Name]
XHsIB GhcRn (LHsType GhcRn)
vars
                            , hsib_body :: LHsType GhcRn
hsib_body = LHsType GhcRn
hs_ty' }
       ; (a
res, FreeVars
fvs2) <- LHsSigWcType GhcRn -> RnM (a, FreeVars)
thing_inside LHsSigWcType GhcRn
sig_ty'
       ; (a, FreeVars) -> RnM (a, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
res, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) } }
rn_hs_sig_wc_type HsSigWcTypeScoping
_ HsDocContext
_ (HsWC XHsWC GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
_ (XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
nec)) LHsSigWcType GhcRn -> RnM (a, FreeVars)
_
  = NoExtCon -> RnM (a, FreeVars)
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs GhcPs (LHsType GhcPs)
NoExtCon
nec
rn_hs_sig_wc_type HsSigWcTypeScoping
_ HsDocContext
_ (XHsWildCardBndrs XXHsWildCardBndrs GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
nec) LHsSigWcType GhcRn -> RnM (a, FreeVars)
_
  = NoExtCon -> RnM (a, FreeVars)
forall a. NoExtCon -> a
noExtCon XXHsWildCardBndrs GhcPs (HsImplicitBndrs GhcPs (LHsType GhcPs))
NoExtCon
nec

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 { FreeKiTyVarsWithDups
free_vars <- LHsType GhcPs -> RnM FreeKiTyVarsWithDups
extractFilteredRdrTyVars LHsType GhcPs
hs_ty
       ; (FreeKiTyVarsWithDups
nwc_rdrs, FreeKiTyVarsWithDups
_) <- FreeKiTyVarsWithDups
-> RnM (FreeKiTyVarsWithDups, FreeKiTyVarsWithDups)
partition_nwcs FreeKiTyVarsWithDups
free_vars
       ; ([Name]
wcs, LHsType GhcRn
hs_ty', FreeVars
fvs) <- HsDocContext
-> FreeKiTyVarsWithDups
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody HsDocContext
ctxt FreeKiTyVarsWithDups
nwc_rdrs LHsType GhcPs
hs_ty
       ; let sig_ty' :: LHsWcType GhcRn
sig_ty' = HsWC :: forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC { hswc_ext :: XHsWC GhcRn (LHsType GhcRn)
hswc_ext = [Name]
XHsWC GhcRn (LHsType GhcRn)
wcs, hswc_body :: LHsType GhcRn
hswc_body = LHsType GhcRn
hs_ty' }
       ; (LHsWcType GhcRn, FreeVars) -> RnM (LHsWcType GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsWcType GhcRn
sig_ty', FreeVars
fvs) }
rnHsWcType HsDocContext
_ (XHsWildCardBndrs XXHsWildCardBndrs GhcPs (LHsType GhcPs)
nec) = NoExtCon -> RnM (LHsWcType GhcRn, FreeVars)
forall a. NoExtCon -> a
noExtCon XXHsWildCardBndrs GhcPs (LHsType GhcPs)
NoExtCon
nec

rnWcBody :: HsDocContext -> [Located RdrName] -> LHsType GhcPs
         -> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody :: HsDocContext
-> FreeKiTyVarsWithDups
-> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
rnWcBody HsDocContext
ctxt FreeKiTyVarsWithDups
nwc_rdrs LHsType GhcPs
hs_ty
  = do { [Name]
nwcs <- (Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> FreeKiTyVarsWithDups -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
newLocalBndrRn FreeKiTyVarsWithDups
nwc_rdrs
       ; let env :: RnTyKiEnv
env = RTKE :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> FreeVars -> RnTyKiEnv
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 }
       ; (LHsType GhcRn
hs_ty', FreeVars
fvs) <- [Name]
-> RnM (LHsType GhcRn, FreeVars) -> RnM (LHsType GhcRn, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name]
nwcs (RnM (LHsType GhcRn, FreeVars) -> RnM (LHsType GhcRn, FreeVars))
-> RnM (LHsType GhcRn, FreeVars) -> RnM (LHsType GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$
                          RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
forall a a.
(HasSrcSpan a, HasSrcSpan a, SrcSpanLess a ~ HsType GhcRn,
 SrcSpanLess a ~ HsType GhcPs) =>
RnTyKiEnv -> a -> TcRn (a, FreeVars)
rn_lty RnTyKiEnv
env LHsType GhcPs
hs_ty
       ; ([Name], LHsType GhcRn, FreeVars)
-> RnM ([Name], LHsType GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name]
nwcs, LHsType GhcRn
hs_ty', FreeVars
fvs) }
  where
    rn_lty :: RnTyKiEnv -> a -> TcRn (a, FreeVars)
rn_lty RnTyKiEnv
env (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess a
hs_ty)
      = SrcSpan -> TcRn (a, FreeVars) -> TcRn (a, FreeVars)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (TcRn (a, FreeVars) -> TcRn (a, FreeVars))
-> TcRn (a, FreeVars) -> TcRn (a, 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 SrcSpanLess a
HsType GhcPs
hs_ty
           ; (a, FreeVars) -> TcRn (a, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess a -> a
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess a
HsType GhcRn
hs_ty', FreeVars
fvs) }

    rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
    -- A lot of faff just to allow the extra-constraints wildcard to appear
    rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
rn_ty RnTyKiEnv
env hs_ty :: HsType GhcPs
hs_ty@(HsForAllTy { hst_fvf :: forall pass. HsType pass -> ForallVisFlag
hst_fvf = ForallVisFlag
fvf, hst_bndrs :: forall pass. HsType pass -> [LHsTyVarBndr pass]
hst_bndrs = [LHsTyVarBndr GhcPs]
tvs
                                , hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
hs_body })
      = HsDocContext
-> Maybe MsgDoc
-> Maybe Any
-> [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (HsType GhcRn, FreeVars))
-> RnM (HsType GhcRn, FreeVars)
forall a b.
HsDocContext
-> Maybe MsgDoc
-> Maybe a
-> [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndrs (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) (MsgDoc -> Maybe MsgDoc
forall a. a -> Maybe a
Just (MsgDoc -> Maybe MsgDoc) -> MsgDoc -> Maybe MsgDoc
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> MsgDoc
inTypeDoc HsType GhcPs
hs_ty) Maybe Any
forall a. Maybe a
Nothing [LHsTyVarBndr GhcPs]
tvs (([LHsTyVarBndr GhcRn] -> RnM (HsType GhcRn, FreeVars))
 -> RnM (HsType GhcRn, FreeVars))
-> ([LHsTyVarBndr GhcRn] -> RnM (HsType GhcRn, FreeVars))
-> RnM (HsType GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [LHsTyVarBndr GhcRn]
tvs' ->
        do { (LHsType GhcRn
hs_body', FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
forall a a.
(HasSrcSpan a, HasSrcSpan a, SrcSpanLess a ~ HsType GhcRn,
 SrcSpanLess a ~ HsType GhcPs) =>
RnTyKiEnv -> a -> TcRn (a, FreeVars)
rn_lty RnTyKiEnv
env LHsType GhcPs
hs_body
           ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsForAllTy :: forall pass.
XForAllTy pass
-> ForallVisFlag
-> [LHsTyVarBndr pass]
-> LHsType pass
-> HsType pass
HsForAllTy { hst_fvf :: ForallVisFlag
hst_fvf = ForallVisFlag
fvf, hst_xforall :: XForAllTy GhcRn
hst_xforall = XForAllTy GhcRn
NoExtField
noExtField
                                , hst_bndrs :: [LHsTyVarBndr GhcRn]
hst_bndrs = [LHsTyVarBndr GhcRn]
tvs', hst_body :: LHsType GhcRn
hst_body = LHsType GhcRn
hs_body' }
                    , FreeVars
fvs) }

    rn_ty RnTyKiEnv
env (HsQualTy { hst_ctxt :: forall pass. HsType pass -> LHsContext pass
hst_ctxt = LHsContext GhcPs -> Located (SrcSpanLess (LHsContext GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
cx SrcSpanLess (LHsContext GhcPs)
hs_ctxt
                        , hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
hs_ty })
      | Just ([LHsType GhcPs]
hs_ctxt1, LHsType GhcPs
hs_ctxt_last) <- [LHsType GhcPs] -> Maybe ([LHsType GhcPs], LHsType GhcPs)
forall a. [a] -> Maybe ([a], a)
snocView [LHsType GhcPs]
SrcSpanLess (LHsContext GhcPs)
hs_ctxt
      , (LHsType GhcPs -> Located (SrcSpanLess (LHsType GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
lx (HsWildCardTy _))  <- LHsType GhcPs -> LHsType GhcPs
forall pass. LHsType pass -> LHsType pass
ignoreParens LHsType GhcPs
hs_ctxt_last
      = do { ([LHsType GhcRn]
hs_ctxt1', FreeVars
fvs1) <- (LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars))
-> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rn_top_constraint RnTyKiEnv
env) [LHsType GhcPs]
hs_ctxt1
           ; SrcSpan -> TcRn () -> TcRn ()
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
lx (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ RnTyKiEnv -> [LHsType GhcPs] -> TcRn ()
checkExtraConstraintWildCard RnTyKiEnv
env [LHsType GhcPs]
hs_ctxt1
           ; let hs_ctxt' :: [LHsType GhcRn]
hs_ctxt' = [LHsType GhcRn]
hs_ctxt1' [LHsType GhcRn] -> [LHsType GhcRn] -> [LHsType GhcRn]
forall a. [a] -> [a] -> [a]
++ [SrcSpan -> SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
lx (XWildCardTy GhcRn -> HsType GhcRn
forall pass. XWildCardTy pass -> HsType pass
HsWildCardTy XWildCardTy GhcRn
NoExtField
noExtField)]
           ; (LHsType 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 (m :: * -> *) a. Monad m => a -> m a
return (HsQualTy :: forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy { hst_xqual :: XQualTy GhcRn
hst_xqual = XQualTy GhcRn
NoExtField
noExtField
                              , hst_ctxt :: LHsContext GhcRn
hst_ctxt = SrcSpan -> SrcSpanLess (LHsContext GhcRn) -> LHsContext GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
cx [LHsType GhcRn]
SrcSpanLess (LHsContext GhcRn)
hs_ctxt', hst_body :: LHsType GhcRn
hst_body = LHsType GhcRn
hs_ty' }
                    , FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }

      | Bool
otherwise
      = do { ([LHsType GhcRn]
hs_ctxt', FreeVars
fvs1) <- (LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars))
-> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rn_top_constraint RnTyKiEnv
env) [LHsType GhcPs]
SrcSpanLess (LHsContext GhcPs)
hs_ctxt
           ; (LHsType 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 (m :: * -> *) a. Monad m => a -> m a
return (HsQualTy :: forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy { hst_xqual :: XQualTy GhcRn
hst_xqual = XQualTy GhcRn
NoExtField
noExtField
                              , hst_ctxt :: LHsContext GhcRn
hst_ctxt = SrcSpan -> SrcSpanLess (LHsContext GhcRn) -> LHsContext GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
cx [LHsType GhcRn]
SrcSpanLess (LHsContext GhcRn)
hs_ctxt'
                              , hst_body :: LHsType GhcRn
hst_body = LHsType 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 ()
-- Rename the extra-constraint spot in a type signature
--    (blah, _) => type
-- Check that extra-constraints are allowed at all, and
-- if so that it's an anonymous wildcard
checkExtraConstraintWildCard :: RnTyKiEnv -> [LHsType GhcPs] -> TcRn ()
checkExtraConstraintWildCard RnTyKiEnv
env [LHsType GhcPs]
hs_ctxt
  = RnTyKiEnv -> Maybe MsgDoc -> TcRn ()
checkWildCard RnTyKiEnv
env Maybe MsgDoc
mb_bad
  where
    mb_bad :: Maybe MsgDoc
mb_bad | Bool -> Bool
not (RnTyKiEnv -> Bool
extraConstraintWildCardsAllowed RnTyKiEnv
env)
           = MsgDoc -> Maybe MsgDoc
forall a. a -> Maybe a
Just MsgDoc
base_msg
             -- Currently, we do not allow wildcards in their full glory in
             -- standalone deriving declarations. We only allow a single
             -- extra-constraints wildcard à la:
             --
             --   deriving instance _ => Eq (Foo a)
             --
             -- i.e., we don't support things like
             --
             --   deriving instance (Eq a, _) => Eq (Foo a)
           | DerivDeclCtx {} <- RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env
           , Bool -> Bool
not ([LHsType GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsType GhcPs]
hs_ctxt)
           = MsgDoc -> Maybe MsgDoc
forall a. a -> Maybe a
Just MsgDoc
deriv_decl_msg
           | Bool
otherwise
           = Maybe MsgDoc
forall a. Maybe a
Nothing

    base_msg :: MsgDoc
base_msg = String -> MsgDoc
text String
"Extra-constraint wildcard" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
pprAnonWildCard
                   MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"not allowed"

    deriv_decl_msg :: MsgDoc
deriv_decl_msg
      = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang MsgDoc
base_msg
           Int
2 ([MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"except as the sole constraint"
                   , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"e.g., deriving instance _ => Eq (Foo a)") ])

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

-- | Finds free type and kind variables in a type,
--     without duplicates, and
--     without variables that are already in scope in LocalRdrEnv
--   NB: this includes named wildcards, which look like perfectly
--       ordinary type variables at this point
extractFilteredRdrTyVars :: LHsType GhcPs -> RnM FreeKiTyVarsNoDups
extractFilteredRdrTyVars :: LHsType GhcPs -> RnM FreeKiTyVarsWithDups
extractFilteredRdrTyVars LHsType GhcPs
hs_ty = FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
filterInScopeM (LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVars LHsType GhcPs
hs_ty)

-- | Finds free type and kind variables in a type,
--     with duplicates, but
--     without variables that are already in scope in LocalRdrEnv
--   NB: this includes named wildcards, which look like perfectly
--       ordinary type variables at this point
extractFilteredRdrTyVarsDups :: LHsType GhcPs -> RnM FreeKiTyVarsWithDups
extractFilteredRdrTyVarsDups :: LHsType GhcPs -> RnM FreeKiTyVarsWithDups
extractFilteredRdrTyVarsDups LHsType GhcPs
hs_ty = FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
filterInScopeM (LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVarsDups LHsType GhcPs
hs_ty)

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

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

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


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

rnHsSigType :: HsDocContext
            -> TypeOrKind
            -> LHsSigType GhcPs
            -> RnM (LHsSigType GhcRn, FreeVars)
-- Used for source-language type signatures
-- that cannot have wildcards
rnHsSigType :: HsDocContext
-> TypeOrKind
-> HsImplicitBndrs GhcPs (LHsType GhcPs)
-> RnM (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars)
rnHsSigType HsDocContext
ctx TypeOrKind
level (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcPs
hs_ty })
  = do { String -> MsgDoc -> TcRn ()
traceRn String
"rnHsSigType" (LHsType GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr LHsType GhcPs
hs_ty)
       ; FreeKiTyVarsWithDups
vars <- LHsType GhcPs -> RnM FreeKiTyVarsWithDups
extractFilteredRdrTyVarsDups LHsType GhcPs
hs_ty
       ; Bool
-> FreeKiTyVarsWithDups
-> ([Name]
    -> RnM (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars))
-> RnM (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars)
forall a.
Bool
-> FreeKiTyVarsWithDups
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnImplicitBndrs (Bool -> Bool
not (LHsType GhcPs -> Bool
forall p. LHsType p -> Bool
isLHsForAllTy LHsType GhcPs
hs_ty)) FreeKiTyVarsWithDups
vars (([Name] -> RnM (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars))
 -> RnM (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars))
-> ([Name]
    -> RnM (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars))
-> RnM (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
vars ->
    do { (LHsType GhcRn
body', FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi (HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
ctx TypeOrKind
level RnTyKiWhat
RnTypeBody) LHsType GhcPs
hs_ty

       ; (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars)
-> RnM (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( HsIB :: forall pass thing.
XHsIB pass thing -> thing -> HsImplicitBndrs pass thing
HsIB { hsib_ext :: XHsIB GhcRn (LHsType GhcRn)
hsib_ext = [Name]
XHsIB GhcRn (LHsType GhcRn)
vars
                       , hsib_body :: LHsType GhcRn
hsib_body = LHsType GhcRn
body' }
                , FreeVars
fvs ) } }
rnHsSigType HsDocContext
_ TypeOrKind
_ (XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
nec) = NoExtCon -> RnM (HsImplicitBndrs GhcRn (LHsType GhcRn), FreeVars)
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs GhcPs (LHsType GhcPs)
NoExtCon
nec

rnImplicitBndrs :: Bool    -- True <=> bring into scope any free type variables
                           -- E.g.  f :: forall a. a->b
                           --  we do not want to bring 'b' into scope, hence False
                           -- But   f :: a -> b
                           --  we want to bring both 'a' and 'b' into scope
                -> FreeKiTyVarsWithDups
                                   -- Free vars of hs_ty (excluding wildcards)
                                   -- May have duplicates, which is
                                   -- checked here
                -> ([Name] -> RnM (a, FreeVars))
                -> RnM (a, FreeVars)
rnImplicitBndrs :: Bool
-> FreeKiTyVarsWithDups
-> ([Name] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnImplicitBndrs Bool
bind_free_tvs
                FreeKiTyVarsWithDups
fvs_with_dups
                [Name] -> RnM (a, FreeVars)
thing_inside
  = do { let fvs :: FreeKiTyVarsWithDups
fvs = FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. Eq a => [Located a] -> [Located a]
nubL FreeKiTyVarsWithDups
fvs_with_dups
             real_fvs :: FreeKiTyVarsWithDups
real_fvs | Bool
bind_free_tvs = FreeKiTyVarsWithDups
fvs
                      | Bool
otherwise     = []

       ; String -> MsgDoc -> TcRn ()
traceRn String
"rnImplicitBndrs" (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$
         [MsgDoc] -> MsgDoc
vcat [ FreeKiTyVarsWithDups -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FreeKiTyVarsWithDups
fvs_with_dups, FreeKiTyVarsWithDups -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FreeKiTyVarsWithDups
fvs, FreeKiTyVarsWithDups -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FreeKiTyVarsWithDups
real_fvs ]

       ; SrcSpan
loc <- TcRn SrcSpan
getSrcSpanM
       ; [Name]
vars <- (Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> FreeKiTyVarsWithDups -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
newLocalBndrRn (Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> (Located RdrName -> Located RdrName)
-> Located RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (RdrName -> Located RdrName)
-> (Located RdrName -> RdrName)
-> Located RdrName
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) FreeKiTyVarsWithDups
real_fvs

       ; [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 }

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

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

Note [Context quantification]
-----------------------------
Variables in type signatures are implicitly quantified
when (1) they are in a type signature not beginning
with "forall" or (2) in any qualified type T => R.
We are phasing out (2) since it leads to inconsistencies
(#4426):

data A = A (a -> a)           is an error
data A = A (Eq a => a -> a)   binds "a"
data A = A (Eq a => a -> b)   binds "a" and "b"
data A = A (() => a -> b)     binds "a" and "b"
f :: forall a. a -> b         is an error
f :: forall a. () => a -> b   is an error
f :: forall a. a -> (() => b) binds "a" and "b"

This situation is now considered to be an error. See rnHsTyKi for case
HsForAllTy Qualified.

Note [QualTy in kinds]
~~~~~~~~~~~~~~~~~~~~~~
I was wondering whether QualTy could occur only at TypeLevel.  But no,
we can have a qualified type in a kind too. Here is an example:

  type family F a where
    F Bool = Nat
    F Nat  = Type

  type family G a where
    G Type = Type -> Type
    G ()   = Nat

  data X :: forall k1 k2. (F k1 ~ G k2) => k1 -> k2 -> Type where
    MkX :: X 'True '()

See that k1 becomes Bool and k2 becomes (), so the equality is
satisfied. If I write MkX :: X 'True 'False, compilation fails with a
suitable message:

  MkX :: X 'True '()
    • Couldn't match kind ‘G Bool’ with ‘Nat’
      Expected kind: G Bool
        Actual kind: F Bool

However: in a kind, the constraints in the QualTy must all be
equalities; or at least, any kinds with a class constraint are
uninhabited.
-}

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

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

instance Outputable RnTyKiEnv where
  ppr :: RnTyKiEnv -> MsgDoc
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 -> MsgDoc
text String
"RTKE"
      MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
braces ([MsgDoc] -> MsgDoc
sep [ TypeOrKind -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr TypeOrKind
lev, RnTyKiWhat -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RnTyKiWhat
what, FreeVars -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FreeVars
wcs
                      , HsDocContext -> MsgDoc
pprHsDocContext HsDocContext
ctxt ])

instance Outputable RnTyKiWhat where
  ppr :: RnTyKiWhat -> MsgDoc
ppr RnTyKiWhat
RnTypeBody      = String -> MsgDoc
text String
"RnTypeBody"
  ppr RnTyKiWhat
RnTopConstraint = String -> MsgDoc
text String
"RnTopConstraint"
  ppr RnTyKiWhat
RnConstraint    = String -> MsgDoc
text String
"RnConstraint"

mkTyKiEnv :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> RnTyKiEnv
mkTyKiEnv HsDocContext
cxt TypeOrKind
level RnTyKiWhat
what
 = RTKE :: HsDocContext -> TypeOrKind -> RnTyKiWhat -> FreeVars -> RnTyKiEnv
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 -> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
rnLHsTypes HsDocContext
doc [LHsType GhcPs]
tys = (LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars))
-> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsType HsDocContext
doc) [LHsType GhcPs]
tys

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

-- renaming a type only, not a 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 { (LHsType GhcRn
tys_rn, FreeVars
fvs) <- HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsType HsDocContext
ctxt LHsType GhcPs
ty
        ; (LHsTypeArg GhcRn, FreeVars) -> RnM (LHsTypeArg GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcRn -> LHsTypeArg GhcRn
forall tm ty. tm -> HsArg tm ty
HsValArg LHsType GhcRn
tys_rn, FreeVars
fvs) }
rnLHsTypeArg HsDocContext
ctxt (HsTypeArg SrcSpan
l LHsType GhcPs
ki)
   = do { (LHsType GhcRn
kis_rn, FreeVars
fvs) <- HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsKind HsDocContext
ctxt LHsType GhcPs
ki
        ; (LHsTypeArg GhcRn, FreeVars) -> RnM (LHsTypeArg GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> LHsType GhcRn -> LHsTypeArg GhcRn
forall tm ty. SrcSpan -> ty -> HsArg tm ty
HsTypeArg SrcSpan
l LHsType GhcRn
kis_rn, FreeVars
fvs) }
rnLHsTypeArg HsDocContext
_ (HsArgPar SrcSpan
sp)
   = (LHsTypeArg GhcRn, FreeVars) -> RnM (LHsTypeArg GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> LHsTypeArg 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 = (LHsTypeArg GhcPs -> RnM (LHsTypeArg GhcRn, FreeVars))
-> [LHsTypeArg GhcPs] -> RnM ([LHsTypeArg 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]
args

--------------
rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs
              -> RnM (LHsContext GhcRn, FreeVars)
rnTyKiContext :: RnTyKiEnv -> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeVars)
rnTyKiContext RnTyKiEnv
env (LHsContext GhcPs -> Located (SrcSpanLess (LHsContext GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LHsContext GhcPs)
cxt)
  = do { String -> MsgDoc -> TcRn ()
traceRn String
"rncontext" ([LHsType GhcPs] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [LHsType GhcPs]
SrcSpanLess (LHsContext GhcPs)
cxt)
       ; let env' :: RnTyKiEnv
env' = RnTyKiEnv
env { rtke_what :: RnTyKiWhat
rtke_what = RnTyKiWhat
RnConstraint }
       ; ([LHsType GhcRn]
cxt', FreeVars
fvs) <- (LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars))
-> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env') [LHsType GhcPs]
SrcSpanLess (LHsContext GhcPs)
cxt
       ; (LHsContext GhcRn, FreeVars) -> RnM (LHsContext GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess (LHsContext GhcRn) -> LHsContext GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc [LHsType GhcRn]
SrcSpanLess (LHsContext 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

--------------
rnLHsTyKi  :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi :: RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env (LHsType GhcPs -> Located (SrcSpanLess (LHsType GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LHsType GhcPs)
ty)
  = SrcSpan
-> RnM (LHsType GhcRn, FreeVars) -> RnM (LHsType GhcRn, FreeVars)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
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 SrcSpanLess (LHsType GhcPs)
HsType GhcPs
ty
       ; (LHsType GhcRn, FreeVars) -> RnM (LHsType GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (LHsType GhcRn)
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_fvf :: forall pass. HsType pass -> ForallVisFlag
hst_fvf = ForallVisFlag
fvf, hst_bndrs :: forall pass. HsType pass -> [LHsTyVarBndr pass]
hst_bndrs = [LHsTyVarBndr GhcPs]
tyvars
                            , 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
-> Maybe MsgDoc
-> Maybe Any
-> [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (HsType GhcRn, FreeVars))
-> RnM (HsType GhcRn, FreeVars)
forall a b.
HsDocContext
-> Maybe MsgDoc
-> Maybe a
-> [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndrs (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) (MsgDoc -> Maybe MsgDoc
forall a. a -> Maybe a
Just (MsgDoc -> Maybe MsgDoc) -> MsgDoc -> Maybe MsgDoc
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> MsgDoc
inTypeDoc HsType GhcPs
ty)
                           Maybe Any
forall a. Maybe a
Nothing [LHsTyVarBndr GhcPs]
tyvars (([LHsTyVarBndr GhcRn] -> RnM (HsType GhcRn, FreeVars))
 -> RnM (HsType GhcRn, FreeVars))
-> ([LHsTyVarBndr GhcRn] -> RnM (HsType GhcRn, FreeVars))
-> RnM (HsType GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [LHsTyVarBndr GhcRn]
tyvars' ->
    do { (LHsType 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 (m :: * -> *) a. Monad m => a -> m a
return ( HsForAllTy :: forall pass.
XForAllTy pass
-> ForallVisFlag
-> [LHsTyVarBndr pass]
-> LHsType pass
-> HsType pass
HsForAllTy { hst_fvf :: ForallVisFlag
hst_fvf = ForallVisFlag
fvf, hst_xforall :: XForAllTy GhcRn
hst_xforall = XForAllTy GhcRn
NoExtField
noExtField
                             , hst_bndrs :: [LHsTyVarBndr GhcRn]
hst_bndrs = [LHsTyVarBndr GhcRn]
tyvars' , hst_body :: LHsType GhcRn
hst_body =  LHsType 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 { RnTyKiEnv -> HsType GhcPs -> TcRn ()
forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
checkPolyKinds RnTyKiEnv
env HsType GhcPs
ty  -- See Note [QualTy in kinds]
       ; (LHsContext GhcRn
ctxt', FreeVars
fvs1) <- RnTyKiEnv -> LHsContext GhcPs -> RnM (LHsContext GhcRn, FreeVars)
rnTyKiContext RnTyKiEnv
env LHsContext GhcPs
lctxt
       ; (LHsType 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 (m :: * -> *) a. Monad m => a -> m a
return (HsQualTy :: forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy { hst_xqual :: XQualTy GhcRn
hst_xqual = XQualTy GhcRn
NoExtField
noExtField, hst_ctxt :: LHsContext GhcRn
hst_ctxt = LHsContext GhcRn
ctxt'
                          , hst_body :: LHsType GhcRn
hst_body =  LHsType GhcRn
tau' }
                , FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }

rnHsTyKi RnTyKiEnv
env (HsTyVar XTyVar GhcPs
_ PromotionFlag
ip (Located (IdP GhcPs) -> Located (SrcSpanLess (Located RdrName))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located 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 SrcSpanLess (Located RdrName)
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
$ MsgDoc -> TcRn ()
addErr (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$
         HsDocContext -> MsgDoc -> MsgDoc
withHsDocContext (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env) (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$
         [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"Unexpected kind variable" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr SrcSpanLess (Located RdrName)
RdrName
rdr_name)
              , String -> MsgDoc
text String
"Perhaps you intended to use PolyKinds" ]
           -- Any type variable at the kind level is illegal without the use
           -- of PolyKinds (see #14710)
       ; Name
name <- RnTyKiEnv -> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
rnTyVar RnTyKiEnv
env SrcSpanLess (Located RdrName)
RdrName
rdr_name
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XTyVar GhcRn
-> PromotionFlag -> Located (IdP GhcRn) -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar XTyVar GhcRn
NoExtField
noExtField PromotionFlag
ip (SrcSpan -> SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc Name
SrcSpanLess (Located Name)
name), Name -> FreeVars
unitFV Name
name) }

rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsOpTy XOpTy GhcPs
_ LHsType GhcPs
ty1 Located (IdP GhcPs)
l_op LHsType GhcPs
ty2)
  = SrcSpan
-> RnM (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc Located RdrName
Located (IdP GhcPs)
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  { (Located Name
l_op', FreeVars
fvs1) <- RnTyKiEnv
-> HsType GhcPs -> Located RdrName -> RnM (Located Name, FreeVars)
forall a.
Outputable a =>
RnTyKiEnv -> a -> Located RdrName -> RnM (Located Name, FreeVars)
rnHsTyOp RnTyKiEnv
env HsType GhcPs
ty Located RdrName
Located (IdP GhcPs)
l_op
        ; Fixity
fix   <- Located Name -> RnM Fixity
lookupTyFixityRn Located Name
l_op'
        ; (LHsType GhcRn
ty1', FreeVars
fvs2) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty1
        ; (LHsType GhcRn
ty2', FreeVars
fvs3) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty2
        ; HsType GhcRn
res_ty <- (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> RnM (HsType GhcRn)
mkHsOpTyRn (\LHsType GhcRn
t1 LHsType GhcRn
t2 -> XOpTy GhcRn
-> LHsType GhcRn
-> Located (IdP GhcRn)
-> LHsType GhcRn
-> HsType GhcRn
forall pass.
XOpTy pass
-> LHsType pass
-> Located (IdP pass)
-> LHsType pass
-> HsType pass
HsOpTy XOpTy GhcRn
NoExtField
noExtField LHsType GhcRn
t1 Located Name
Located (IdP GhcRn)
l_op' LHsType GhcRn
t2)
                               (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
l_op') Fixity
fix LHsType GhcRn
ty1' LHsType GhcRn
ty2'
        ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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 { (LHsType 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 (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
NoExtField
noExtField LHsType GhcRn
ty', FreeVars
fvs) }

rnHsTyKi RnTyKiEnv
env (HsBangTy XBangTy GhcPs
_ HsSrcBang
b LHsType GhcPs
ty)
  = do { (LHsType 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 (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 GhcRn
NoExtField
noExtField HsSrcBang
b LHsType 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
       ; ([LConDeclField 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 (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]
flds', FreeVars
fvs) }
  where
    get_fields :: HsDocContext -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
get_fields (ConDeclCtx [Located Name]
names)
      = (Located Name -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel])
-> [Located 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])
-> (Located Name -> Name)
-> Located Name
-> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located Name]
names
    get_fields HsDocContext
_
      = do { MsgDoc -> TcRn ()
addErr (MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Record syntax is illegal here:")
                                   Int
2 (HsType GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsType GhcPs
ty))
           ; [FieldLabel] -> IOEnv (Env TcGblEnv TcLclEnv) [FieldLabel]
forall (m :: * -> *) a. Monad m => a -> m a
return [] }

rnHsTyKi RnTyKiEnv
env (HsFunTy XFunTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2)
  = do { (LHsType GhcRn
ty1', FreeVars
fvs1) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty1
        -- Might find a for-all as the arg of a function type
       ; (LHsType GhcRn
ty2', FreeVars
fvs2) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty2
        -- Or as the result.  This happens when reading Prelude.hi
        -- when we find return :: forall m. Monad m -> forall a. a -> m a

        -- Check for fixity rearrangements
       ; HsType GhcRn
res_ty <- (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> RnM (HsType GhcRn)
mkHsOpTyRn (XFunTy GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcRn
NoExtField
noExtField) Name
funTyConName Fixity
funTyFixity LHsType GhcRn
ty1' LHsType GhcRn
ty2'
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType GhcRn
res_ty, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }

rnHsTyKi RnTyKiEnv
env listTy :: HsType GhcPs
listTy@(HsListTy XListTy GhcPs
_ 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)
              (MsgDoc -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> MsgDoc
dataKindsErr RnTyKiEnv
env HsType GhcPs
listTy))
       ; (LHsType 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 (m :: * -> *) a. Monad m => a -> m a
return (XListTy GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy XListTy GhcRn
NoExtField
noExtField LHsType GhcRn
ty', FreeVars
fvs) }

rnHsTyKi RnTyKiEnv
env t :: HsType GhcPs
t@(HsKindSig XKindSig GhcPs
_ LHsType GhcPs
ty LHsType GhcPs
k)
  = do { RnTyKiEnv -> HsType GhcPs -> TcRn ()
forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
checkPolyKinds RnTyKiEnv
env HsType GhcPs
t
       ; 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)
       ; (LHsType GhcRn
ty', FreeVars
lhs_fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; (LHsType 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 (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 GhcRn
NoExtField
noExtField LHsType GhcRn
ty' LHsType GhcRn
k', FreeVars
lhs_fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
sig_fvs) }

-- Unboxed tuples are allowed to have poly-typed arguments.  These
-- sometimes crop up as a result of CPR worker-wrappering dictionaries.
rnHsTyKi RnTyKiEnv
env tupleTy :: HsType GhcPs
tupleTy@(HsTupleTy XTupleTy GhcPs
_ HsTupleSort
tup_con [LHsType 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)
              (MsgDoc -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> MsgDoc
dataKindsErr RnTyKiEnv
env HsType GhcPs
tupleTy))
       ; ([LHsType GhcRn]
tys', FreeVars
fvs) <- (LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars))
-> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env) [LHsType GhcPs]
tys
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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 GhcRn
NoExtField
noExtField HsTupleSort
tup_con [LHsType GhcRn]
tys', FreeVars
fvs) }

rnHsTyKi RnTyKiEnv
env sumTy :: HsType GhcPs
sumTy@(HsSumTy XSumTy GhcPs
_ [LHsType 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)
              (MsgDoc -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> MsgDoc
dataKindsErr RnTyKiEnv
env HsType GhcPs
sumTy))
       ; ([LHsType GhcRn]
tys', FreeVars
fvs) <- (LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars))
-> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env) [LHsType GhcPs]
tys
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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 GhcRn
NoExtField
noExtField [LHsType GhcRn]
tys', FreeVars
fvs) }

-- Ensure that a type-level integer is nonnegative (#8306, #8412)
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 (MsgDoc -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> MsgDoc
dataKindsErr RnTyKiEnv
env HsType GhcPs
tyLit))
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HsTyLit -> Bool
negLit HsTyLit
t) (MsgDoc -> TcRn ()
addErr MsgDoc
negLitErr)
       ; RnTyKiEnv -> HsType GhcPs -> TcRn ()
forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
checkPolyKinds RnTyKiEnv
env HsType GhcPs
tyLit
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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
    negLitErr :: MsgDoc
negLitErr = String -> MsgDoc
text String
"Illegal literal in type (type literals must not be negative):" MsgDoc -> MsgDoc -> MsgDoc
<+> HsType GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsType GhcPs
tyLit

rnHsTyKi RnTyKiEnv
env (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2)
  = do { (LHsType GhcRn
ty1', FreeVars
fvs1) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty1
       ; (LHsType 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 (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
ty1' LHsType 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 (MsgDoc -> TcRn ()
addErr (String -> LHsType GhcPs -> MsgDoc
typeAppErr String
"kind" LHsType GhcPs
k))
       ; (LHsType GhcRn
ty', FreeVars
fvs1) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; (LHsType 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 (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
ty' LHsType GhcRn
k', FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }

rnHsTyKi RnTyKiEnv
env t :: HsType GhcPs
t@(HsIParamTy XIParamTy GhcPs
_ Located HsIPName
n LHsType GhcPs
ty)
  = do { RnTyKiEnv -> HsType GhcPs -> TcRn ()
forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
notInKinds RnTyKiEnv
env HsType GhcPs
t
       ; (LHsType 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 (m :: * -> *) a. Monad m => a -> m a
return (XIParamTy GhcRn
-> Located HsIPName -> LHsType GhcRn -> HsType GhcRn
forall pass.
XIParamTy pass -> Located HsIPName -> LHsType pass -> HsType pass
HsIParamTy XIParamTy GhcRn
NoExtField
noExtField Located HsIPName
n LHsType GhcRn
ty', FreeVars
fvs) }

rnHsTyKi RnTyKiEnv
_ (HsStarTy XStarTy GhcPs
_ Bool
isUni)
  = (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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
_ LHsType GhcPs
ty LHsDocString
haddock_doc)
  = do { (LHsType GhcRn
ty', FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; LHsDocString
haddock_doc' <- LHsDocString -> RnM LHsDocString
rnLHsDoc LHsDocString
haddock_doc
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XDocTy GhcRn -> LHsType GhcRn -> LHsDocString -> HsType GhcRn
forall pass.
XDocTy pass -> LHsType pass -> LHsDocString -> HsType pass
HsDocTy XDocTy GhcRn
NoExtField
noExtField LHsType GhcRn
ty' LHsDocString
haddock_doc', FreeVars
fvs) }

rnHsTyKi RnTyKiEnv
_ (XHsType (NHsCoreTy ty))
  = (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XXType GhcRn -> HsType GhcRn
forall pass. XXType pass -> HsType pass
XHsType (Type -> NewHsTypeX
NHsCoreTy Type
ty), FreeVars
emptyFVs)
    -- The emptyFVs probably isn't quite right
    -- but I don't think it matters

rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsExplicitListTy XExplicitListTy GhcPs
_ PromotionFlag
ip [LHsType GhcPs]
tys)
  = do { RnTyKiEnv -> HsType GhcPs -> TcRn ()
forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
checkPolyKinds RnTyKiEnv
env HsType GhcPs
ty
       ; 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 (MsgDoc -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> MsgDoc
dataKindsErr RnTyKiEnv
env HsType GhcPs
ty))
       ; ([LHsType GhcRn]
tys', FreeVars
fvs) <- (LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars))
-> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env) [LHsType GhcPs]
tys
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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]
tys', FreeVars
fvs) }

rnHsTyKi RnTyKiEnv
env ty :: HsType GhcPs
ty@(HsExplicitTupleTy XExplicitTupleTy GhcPs
_ [LHsType GhcPs]
tys)
  = do { RnTyKiEnv -> HsType GhcPs -> TcRn ()
forall ty. Outputable ty => RnTyKiEnv -> ty -> TcRn ()
checkPolyKinds RnTyKiEnv
env HsType GhcPs
ty
       ; 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 (MsgDoc -> TcRn ()
addErr (RnTyKiEnv -> HsType GhcPs -> MsgDoc
dataKindsErr RnTyKiEnv
env HsType GhcPs
ty))
       ; ([LHsType GhcRn]
tys', FreeVars
fvs) <- (LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars))
-> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env) [LHsType GhcPs]
tys
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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]
tys', FreeVars
fvs) }

rnHsTyKi RnTyKiEnv
env (HsWildCardTy XWildCardTy GhcPs
_)
  = do { RnTyKiEnv -> TcRn ()
checkAnonWildCard RnTyKiEnv
env
       ; (HsType GhcRn, FreeVars) -> RnM (HsType GhcRn, FreeVars)
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) }

--------------
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 (m :: * -> *) a. Monad m => a -> m a
return Name
name }

rnLTyVar :: Located RdrName -> RnM (Located Name)
-- Called externally; does not deal with wildards
rnLTyVar :: Located RdrName -> RnM (Located Name)
rnLTyVar (Located RdrName -> Located (SrcSpanLess (Located RdrName))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located RdrName)
rdr_name)
  = do { Name
tyvar <- RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupTypeOccRn SrcSpanLess (Located RdrName)
RdrName
rdr_name
       ; Located Name -> RnM (Located Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc Name
SrcSpanLess (Located Name)
tyvar) }

--------------
rnHsTyOp :: Outputable a
         => RnTyKiEnv -> a -> Located RdrName
         -> RnM (Located Name, FreeVars)
rnHsTyOp :: RnTyKiEnv -> a -> Located RdrName -> RnM (Located Name, FreeVars)
rnHsTyOp RnTyKiEnv
env a
overall_ty (Located RdrName -> Located (SrcSpanLess (Located RdrName))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located RdrName)
op)
  = do { Bool
ops_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeOperators
       ; Name
op' <- RnTyKiEnv -> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
rnTyVar RnTyKiEnv
env SrcSpanLess (Located RdrName)
RdrName
op
       ; Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
ops_ok Bool -> Bool -> Bool
|| Name
op' Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
           MsgDoc -> TcRn ()
addErr (RdrName -> a -> MsgDoc
forall a. Outputable a => RdrName -> a -> MsgDoc
opTyErr SrcSpanLess (Located RdrName)
RdrName
op a
overall_ty)
       ; let l_op' :: Located Name
l_op' = SrcSpan -> SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc Name
SrcSpanLess (Located Name)
op'
       ; (Located Name, FreeVars) -> RnM (Located Name, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located Name
l_op', Name -> FreeVars
unitFV Name
op') }

--------------
notAllowed :: SDoc -> SDoc
notAllowed :: MsgDoc -> MsgDoc
notAllowed MsgDoc
doc
  = String -> MsgDoc
text String
"Wildcard" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes MsgDoc
doc MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"not allowed")

checkWildCard :: RnTyKiEnv -> Maybe SDoc -> RnM ()
checkWildCard :: RnTyKiEnv -> Maybe MsgDoc -> TcRn ()
checkWildCard RnTyKiEnv
env (Just MsgDoc
doc)
  = MsgDoc -> TcRn ()
addErr (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$ [MsgDoc] -> MsgDoc
vcat [MsgDoc
doc, Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"in" MsgDoc -> MsgDoc -> MsgDoc
<+> HsDocContext -> MsgDoc
pprHsDocContext (RnTyKiEnv -> HsDocContext
rtke_ctxt RnTyKiEnv
env))]
checkWildCard RnTyKiEnv
_ Maybe MsgDoc
Nothing
  = () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

    constraint_msg :: MsgDoc
constraint_msg = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang
                         (MsgDoc -> MsgDoc
notAllowed MsgDoc
pprAnonWildCard MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"in a constraint")
                        Int
2 MsgDoc
hint_msg
    hint_msg :: MsgDoc
hint_msg = [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"except as the last top-level constraint of a type signature"
                    , Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"e.g  f :: (Eq a, _) => blah") ]

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

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



---------------
-- | Ensures either that we're in a type or that -XPolyKinds is set
checkPolyKinds :: Outputable ty
                => RnTyKiEnv
                -> ty      -- ^ type
                -> RnM ()
checkPolyKinds :: 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
$
         MsgDoc -> TcRn ()
addErr (String -> MsgDoc
text String
"Illegal kind:" MsgDoc -> MsgDoc -> MsgDoc
<+> ty -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ty
ty MsgDoc -> MsgDoc -> MsgDoc
$$
                 String -> MsgDoc
text String
"Did you mean to enable PolyKinds?") }
checkPolyKinds RnTyKiEnv
_ ty
_ = () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

notInKinds :: Outputable ty
           => RnTyKiEnv
           -> ty
           -> RnM ()
notInKinds :: RnTyKiEnv -> ty -> TcRn ()
notInKinds RnTyKiEnv
env ty
ty
  | RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env
  = MsgDoc -> TcRn ()
addErr (String -> MsgDoc
text String
"Illegal kind:" MsgDoc -> MsgDoc -> MsgDoc
<+> ty -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ty
ty)
notInKinds RnTyKiEnv
_ ty
_ = () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

bindSigTyVarsFV :: [Name]
                -> RnM (a, FreeVars)
                -> RnM (a, FreeVars)
-- Used just before renaming the defn of a function
-- with a separate type signature, to bring its tyvars into scope
-- With no -XScopedTypeVariables, this is a no-op
bindSigTyVarsFV :: [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 }

-- | Simply bring a bunch of RdrNames into scope. No checking for
-- validity, at all. The binding location is taken from the location
-- on each name.
bindLRdrNames :: [Located RdrName]
              -> ([Name] -> RnM (a, FreeVars))
              -> RnM (a, FreeVars)
bindLRdrNames :: FreeKiTyVarsWithDups
-> ([Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars)
bindLRdrNames FreeKiTyVarsWithDups
rdrs [Name] -> RnM (a, FreeVars)
thing_inside
  = do { [Name]
var_names <- (Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> FreeKiTyVarsWithDups -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe Any -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a.
Maybe a -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn Maybe Any
forall a. Maybe a
Nothing) FreeKiTyVarsWithDups
rdrs
       ; [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name]
var_names (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]
var_names }

---------------
bindHsQTyVars :: forall a b.
                 HsDocContext
              -> Maybe SDoc         -- Just d => check for unused tvs
                                    --   d is a phrase like "in the type ..."
              -> Maybe a            -- Just _  => an associated type decl
              -> [Located RdrName]  -- Kind variables from scope, no dups
              -> (LHsQTyVars GhcPs)
              -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars))
                  -- The Bool is True <=> all kind variables used in the
                  -- kind signature are bound on the left.  Reason:
                  -- the last clause of Note [CUSKs: Complete user-supplied
                  -- kind signatures] in GHC.Hs.Decls
              -> RnM (b, FreeVars)

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

       ; let -- See Note [bindHsQTyVars examples] for what
             -- all these various things are doing
             bndrs, kv_occs, implicit_kvs :: [Located RdrName]
             bndrs :: FreeKiTyVarsWithDups
bndrs        = (LHsTyVarBndr GhcPs -> Located RdrName)
-> [LHsTyVarBndr GhcPs] -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr GhcPs -> Located RdrName
forall (p :: Pass).
LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p))
hsLTyVarLocName [LHsTyVarBndr GhcPs]
hs_tv_bndrs
             kv_occs :: FreeKiTyVarsWithDups
kv_occs      = FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. Eq a => [Located a] -> [Located a]
nubL (FreeKiTyVarsWithDups
bndr_kv_occs FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. [a] -> [a] -> [a]
++ FreeKiTyVarsWithDups
body_kv_occs)
                                 -- Make sure to list the binder kvs before the
                                 -- body kvs, as mandated by
                                 -- Note [Ordering of implicit variables]
             implicit_kvs :: FreeKiTyVarsWithDups
implicit_kvs = FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
filter_occs FreeKiTyVarsWithDups
bndrs FreeKiTyVarsWithDups
kv_occs
             del :: FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
del          = (Located RdrName -> Located RdrName -> Bool)
-> FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteBys Located RdrName -> Located RdrName -> Bool
forall a. (HasSrcSpan a, Eq (SrcSpanLess a)) => a -> a -> Bool
eqLocated
             all_bound_on_lhs :: Bool
all_bound_on_lhs = FreeKiTyVarsWithDups -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((FreeKiTyVarsWithDups
body_kv_occs FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
`del` FreeKiTyVarsWithDups
bndrs) FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
`del` FreeKiTyVarsWithDups
bndr_kv_occs)

       ; String -> MsgDoc -> TcRn ()
traceRn String
"checkMixedVars3" (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$
           [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"kv_occs" MsgDoc -> MsgDoc -> MsgDoc
<+> FreeKiTyVarsWithDups -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FreeKiTyVarsWithDups
kv_occs
                , String -> MsgDoc
text String
"bndrs"   MsgDoc -> MsgDoc -> MsgDoc
<+> [LHsTyVarBndr GhcPs] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [LHsTyVarBndr GhcPs]
hs_tv_bndrs
                , String -> MsgDoc
text String
"bndr_kv_occs"   MsgDoc -> MsgDoc -> MsgDoc
<+> FreeKiTyVarsWithDups -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FreeKiTyVarsWithDups
bndr_kv_occs
                , String -> MsgDoc
text String
"wubble" MsgDoc -> MsgDoc -> MsgDoc
<+> FreeKiTyVarsWithDups -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ((FreeKiTyVarsWithDups
kv_occs FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. Eq a => [a] -> [a] -> [a]
\\ FreeKiTyVarsWithDups
bndrs) FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. Eq a => [a] -> [a] -> [a]
\\ FreeKiTyVarsWithDups
bndr_kv_occs)
                ]

       ; [Name]
implicit_kv_nms <- (Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name)
-> FreeKiTyVarsWithDups -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe a -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a.
Maybe a -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn Maybe a
mb_assoc) FreeKiTyVarsWithDups
implicit_kvs

       ; [Name] -> RnM (b, FreeVars) -> RnM (b, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name]
implicit_kv_nms                     (RnM (b, FreeVars) -> RnM (b, FreeVars))
-> RnM (b, FreeVars) -> RnM (b, FreeVars)
forall a b. (a -> b) -> a -> b
$
         HsDocContext
-> Maybe MsgDoc
-> Maybe a
-> [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
forall a b.
HsDocContext
-> Maybe MsgDoc
-> Maybe a
-> [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndrs HsDocContext
doc Maybe MsgDoc
mb_in_doc 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 { String -> MsgDoc -> TcRn ()
traceRn String
"bindHsQTyVars" (LHsQTyVars GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr LHsQTyVars GhcPs
hsq_bndrs MsgDoc -> MsgDoc -> MsgDoc
$$ [Name] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [Name]
implicit_kv_nms MsgDoc -> MsgDoc -> MsgDoc
$$ [LHsTyVarBndr GhcRn] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [LHsTyVarBndr GhcRn]
rn_bndrs)
       ; LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)
thing_inside (HsQTvs :: forall pass. XHsQTvs pass -> [LHsTyVarBndr pass] -> LHsQTyVars pass
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
    filter_occs :: [Located RdrName]   -- Bound here
                -> [Located RdrName]   -- Potential implicit binders
                -> [Located RdrName]   -- Final implicit binders
    -- Filter out any potential implicit binders that are either
    -- already in scope, or are explicitly bound in the same HsQTyVars
    filter_occs :: FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
filter_occs FreeKiTyVarsWithDups
bndrs FreeKiTyVarsWithDups
occs
      = (Located RdrName -> Bool)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. (a -> Bool) -> [a] -> [a]
filterOut Located RdrName -> Bool
is_in_scope FreeKiTyVarsWithDups
occs
      where
        is_in_scope :: Located RdrName -> Bool
is_in_scope Located RdrName
locc = Located RdrName
locc Located RdrName -> FreeKiTyVarsWithDups -> Bool
`elemRdr` FreeKiTyVarsWithDups
bndrs

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

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

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

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

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

* We want to quantify add implicit bindings for implicit_kvs

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

* Order is not important in these lists.  All we are doing is
  bring Names into scope.

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

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

So the rule is:

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

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

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

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

In implementation terms

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

* Similarly in extract_hs_tv_bndrs

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

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

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

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

   forall k (a :: k). Proxy a

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

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

bindLHsTyVarBndrs :: HsDocContext
                  -> Maybe SDoc            -- Just d => check for unused tvs
                                           --   d is a phrase like "in the type ..."
                  -> Maybe a               -- Just _  => an associated type decl
                  -> [LHsTyVarBndr GhcPs]  -- User-written tyvars
                  -> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars))
                  -> RnM (b, FreeVars)
bindLHsTyVarBndrs :: HsDocContext
-> Maybe MsgDoc
-> Maybe a
-> [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndrs HsDocContext
doc Maybe MsgDoc
mb_in_doc Maybe a
mb_assoc [LHsTyVarBndr GhcPs]
tv_bndrs [LHsTyVarBndr 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) (FreeKiTyVarsWithDups -> TcRn ()
checkShadowedRdrNames FreeKiTyVarsWithDups
tv_names_w_loc)
       ; FreeKiTyVarsWithDups -> TcRn ()
checkDupRdrNames FreeKiTyVarsWithDups
tv_names_w_loc
       ; [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars)) -> RnM (b, FreeVars)
go [LHsTyVarBndr GhcPs]
tv_bndrs [LHsTyVarBndr GhcRn] -> RnM (b, FreeVars)
thing_inside }
  where
    tv_names_w_loc :: FreeKiTyVarsWithDups
tv_names_w_loc = (LHsTyVarBndr GhcPs -> Located RdrName)
-> [LHsTyVarBndr GhcPs] -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr GhcPs -> Located RdrName
forall (p :: Pass).
LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p))
hsLTyVarLocName [LHsTyVarBndr GhcPs]
tv_bndrs

    go :: [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars)) -> RnM (b, FreeVars)
go []     [LHsTyVarBndr GhcRn] -> RnM (b, FreeVars)
thing_inside = [LHsTyVarBndr GhcRn] -> RnM (b, FreeVars)
thing_inside []
    go (LHsTyVarBndr GhcPs
b:[LHsTyVarBndr GhcPs]
bs) [LHsTyVarBndr GhcRn] -> RnM (b, FreeVars)
thing_inside = HsDocContext
-> Maybe a
-> LHsTyVarBndr GhcPs
-> (LHsTyVarBndr GhcRn -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
forall a b.
HsDocContext
-> Maybe a
-> LHsTyVarBndr GhcPs
-> (LHsTyVarBndr GhcRn -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndr HsDocContext
doc Maybe a
mb_assoc LHsTyVarBndr GhcPs
b ((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
b' ->
                             do { (b
res, FreeVars
fvs) <- [LHsTyVarBndr GhcPs]
-> ([LHsTyVarBndr GhcRn] -> RnM (b, FreeVars)) -> RnM (b, FreeVars)
go [LHsTyVarBndr GhcPs]
bs (([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]
bs' ->
                                                [LHsTyVarBndr GhcRn] -> RnM (b, FreeVars)
thing_inside (LHsTyVarBndr GhcRn
b' LHsTyVarBndr GhcRn -> [LHsTyVarBndr GhcRn] -> [LHsTyVarBndr GhcRn]
forall a. a -> [a] -> [a]
: [LHsTyVarBndr GhcRn]
bs')
                                ; LHsTyVarBndr GhcRn -> FreeVars -> TcRn ()
warn_unused LHsTyVarBndr GhcRn
b' FreeVars
fvs
                                ; (b, FreeVars) -> RnM (b, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
res, FreeVars
fvs) }

    warn_unused :: LHsTyVarBndr GhcRn -> FreeVars -> TcRn ()
warn_unused LHsTyVarBndr GhcRn
tv_bndr FreeVars
fvs = case Maybe MsgDoc
mb_in_doc of
      Just MsgDoc
in_doc -> MsgDoc -> LHsTyVarBndr GhcRn -> FreeVars -> TcRn ()
warnUnusedForAll MsgDoc
in_doc LHsTyVarBndr GhcRn
tv_bndr FreeVars
fvs
      Maybe MsgDoc
Nothing     -> () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

bindLHsTyVarBndr :: HsDocContext
                 -> Maybe a   -- associated class
                 -> LHsTyVarBndr GhcPs
                 -> (LHsTyVarBndr GhcRn -> RnM (b, FreeVars))
                 -> RnM (b, FreeVars)
bindLHsTyVarBndr :: HsDocContext
-> Maybe a
-> LHsTyVarBndr GhcPs
-> (LHsTyVarBndr GhcRn -> RnM (b, FreeVars))
-> RnM (b, FreeVars)
bindLHsTyVarBndr HsDocContext
_doc Maybe a
mb_assoc (LHsTyVarBndr GhcPs -> Located (SrcSpanLess (LHsTyVarBndr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc
                                 (UserTyVar x
                                    lrdr@(dL->L lv _))) LHsTyVarBndr GhcRn -> RnM (b, FreeVars)
thing_inside
  = do { Name
nm <- Maybe a -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a.
Maybe a -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn Maybe a
mb_assoc Located RdrName
Located (IdP GhcPs)
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 GhcRn -> RnM (b, FreeVars)
thing_inside (SrcSpan -> SrcSpanLess (LHsTyVarBndr GhcRn) -> LHsTyVarBndr GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XUserTyVar GhcRn -> Located (IdP GhcRn) -> HsTyVarBndr GhcRn
forall pass.
XUserTyVar pass -> Located (IdP pass) -> HsTyVarBndr pass
UserTyVar XUserTyVar GhcPs
XUserTyVar GhcRn
x (SrcSpan -> SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
lv Name
SrcSpanLess (Located Name)
nm))) }

bindLHsTyVarBndr HsDocContext
doc Maybe a
mb_assoc (LHsTyVarBndr GhcPs -> Located (SrcSpanLess (LHsTyVarBndr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (KindedTyVar x lrdr@(dL->L lv _) kind))
                 LHsTyVarBndr 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)
           ; (LHsType GhcRn
kind', FreeVars
fvs1) <- HsDocContext -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsKind HsDocContext
doc LHsType GhcPs
kind
           ; Name
tv_nm  <- Maybe a -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a.
Maybe a -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn Maybe a
mb_assoc Located RdrName
Located (IdP GhcPs)
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 GhcRn -> RnM (b, FreeVars)
thing_inside (SrcSpan -> SrcSpanLess (LHsTyVarBndr GhcRn) -> LHsTyVarBndr GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XKindedTyVar GhcRn
-> Located (IdP GhcRn) -> LHsType GhcRn -> HsTyVarBndr GhcRn
forall pass.
XKindedTyVar pass
-> Located (IdP pass) -> LHsKind pass -> HsTyVarBndr pass
KindedTyVar XKindedTyVar GhcPs
XKindedTyVar GhcRn
x (SrcSpan -> SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
lv Name
SrcSpanLess (Located Name)
tv_nm) LHsType GhcRn
kind'))
           ; (b, FreeVars) -> RnM (b, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2) }

bindLHsTyVarBndr HsDocContext
_ Maybe a
_ (LHsTyVarBndr GhcPs -> Located (SrcSpanLess (LHsTyVarBndr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (XTyVarBndr nec)) LHsTyVarBndr GhcRn -> RnM (b, FreeVars)
_ = NoExtCon -> RnM (b, FreeVars)
forall a. NoExtCon -> a
noExtCon XXTyVarBndr GhcPs
NoExtCon
nec
bindLHsTyVarBndr HsDocContext
_ Maybe a
_ LHsTyVarBndr GhcPs
_ LHsTyVarBndr GhcRn -> RnM (b, FreeVars)
_ = String -> RnM (b, FreeVars)
forall a. String -> a
panic String
"bindLHsTyVarBndr: Impossible Match"
                             -- due to #15884

newTyVarNameRn :: Maybe a -> Located RdrName -> RnM Name
newTyVarNameRn :: Maybe a -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
newTyVarNameRn Maybe a
mb_assoc (Located RdrName -> Located (SrcSpanLess (Located RdrName))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located RdrName)
rdr)
  = do { LocalRdrEnv
rdr_env <- RnM LocalRdrEnv
getLocalRdrEnv
       ; case (Maybe a
mb_assoc, LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv LocalRdrEnv
rdr_env SrcSpanLess (Located RdrName)
RdrName
rdr) of
           (Just a
_, Just Name
n) -> Name -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
              -- Use the same Name as the parent class decl

           (Maybe a, Maybe Name)
_                -> Located RdrName -> IOEnv (Env TcGblEnv TcLclEnv) Name
newLocalBndrRn (SrcSpan -> SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located RdrName)
rdr) }
{-
*********************************************************
*                                                       *
        ConDeclField
*                                                       *
*********************************************************

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

rnConDeclFields :: HsDocContext -> [FieldLabel] -> [LConDeclField GhcPs]
                -> RnM ([LConDeclField GhcRn], FreeVars)
-- Also called from RnSource
-- No wildcards can appear in record fields
rnConDeclFields :: HsDocContext
-> [FieldLabel]
-> [LConDeclField GhcPs]
-> RnM ([LConDeclField GhcRn], FreeVars)
rnConDeclFields HsDocContext
ctxt [FieldLabel]
fls [LConDeclField GhcPs]
fields
   = (LConDeclField GhcPs -> RnM (LConDeclField GhcRn, FreeVars))
-> [LConDeclField GhcPs] -> RnM ([LConDeclField 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]
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
forall a. FieldLbl a -> 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 (LConDeclField GhcPs -> Located (SrcSpanLess (LConDeclField GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l (ConDeclField _ names ty haddock_doc))
  = do { let new_names :: [GenLocated SrcSpan (FieldOcc GhcRn)]
new_names = (GenLocated SrcSpan (FieldOcc GhcPs)
 -> GenLocated SrcSpan (FieldOcc GhcRn))
-> [GenLocated SrcSpan (FieldOcc GhcPs)]
-> [GenLocated SrcSpan (FieldOcc GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map ((FieldOcc GhcPs -> FieldOcc GhcRn)
-> GenLocated SrcSpan (FieldOcc GhcPs)
-> GenLocated SrcSpan (FieldOcc GhcRn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldOcc GhcPs -> FieldOcc GhcRn
lookupField) [GenLocated SrcSpan (FieldOcc GhcPs)]
names
       ; (LHsType GhcRn
new_ty, FreeVars
fvs) <- RnTyKiEnv -> LHsType GhcPs -> RnM (LHsType GhcRn, FreeVars)
rnLHsTyKi RnTyKiEnv
env LHsType GhcPs
ty
       ; Maybe LHsDocString
new_haddock_doc <- Maybe LHsDocString -> RnM (Maybe LHsDocString)
rnMbLHsDoc Maybe LHsDocString
haddock_doc
       ; (LConDeclField GhcRn, FreeVars)
-> RnM (LConDeclField GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess (LConDeclField GhcRn) -> LConDeclField GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (XConDeclField GhcRn
-> [GenLocated SrcSpan (FieldOcc GhcRn)]
-> LHsType GhcRn
-> Maybe LHsDocString
-> ConDeclField GhcRn
forall pass.
XConDeclField pass
-> [LFieldOcc pass]
-> LBangType pass
-> Maybe LHsDocString
-> ConDeclField pass
ConDeclField XConDeclField GhcRn
NoExtField
noExtField [GenLocated SrcSpan (FieldOcc GhcRn)]
new_names LHsType GhcRn
new_ty Maybe LHsDocString
new_haddock_doc)
                , FreeVars
fvs) }
  where
    lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn
    lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn
lookupField (FieldOcc XCFieldOcc GhcPs
_ (Located RdrName -> Located (SrcSpanLess (Located RdrName))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
lr SrcSpanLess (Located RdrName)
rdr)) =
        XCFieldOcc GhcRn -> Located RdrName -> FieldOcc GhcRn
forall pass. XCFieldOcc pass -> Located RdrName -> FieldOcc pass
FieldOcc (FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector FieldLabel
fl) (SrcSpan -> SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
lr SrcSpanLess (Located RdrName)
rdr)
      where
        lbl :: FastString
lbl = OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc SrcSpanLess (Located RdrName)
RdrName
rdr
        fl :: FieldLabel
fl  = String -> Maybe FieldLabel -> FieldLabel
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"rnField" (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
    lookupField (XFieldOcc XXFieldOcc GhcPs
nec) = NoExtCon -> FieldOcc GhcRn
forall a. NoExtCon -> a
noExtCon XXFieldOcc GhcPs
NoExtCon
nec
rnField FastStringEnv FieldLabel
_ RnTyKiEnv
_ (LConDeclField GhcPs -> Located (SrcSpanLess (LConDeclField GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (XConDeclField nec)) = NoExtCon -> RnM (LConDeclField GhcRn, FreeVars)
forall a. NoExtCon -> a
noExtCon XXConDeclField GhcPs
NoExtCon
nec
rnField FastStringEnv FieldLabel
_ RnTyKiEnv
_ LConDeclField GhcPs
_ = String -> RnM (LConDeclField GhcRn, FreeVars)
forall a. String -> a
panic String
"rnField: Impossible Match"
                             -- due to #15884

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

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

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

mkHsOpTyRn rearranges where necessary.  The two arguments
have already been renamed and rearranged.  It's made rather tiresome
by the presence of ->, which is a separate syntactic construct.
-}

---------------
-- Building (ty1 `op1` (ty21 `op2` ty22))
mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
           -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn
           -> RnM (HsType GhcRn)

mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> RnM (HsType GhcRn)
mkHsOpTyRn LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 Name
pp_op1 Fixity
fix1 LHsType GhcRn
ty1 (LHsType GhcRn -> Located (SrcSpanLess (LHsType GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc2 (HsOpTy noExtField ty21 op2 ty22))
  = do  { Fixity
fix2 <- Located Name -> RnM Fixity
lookupTyFixityRn Located Name
Located (IdP GhcRn)
op2
        ; (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> SrcSpan
-> RnM (HsType GhcRn)
mk_hs_op_ty LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 Name
pp_op1 Fixity
fix1 LHsType GhcRn
ty1
                      (\LHsType GhcRn
t1 LHsType GhcRn
t2 -> XOpTy GhcRn
-> LHsType GhcRn
-> Located (IdP GhcRn)
-> LHsType GhcRn
-> HsType GhcRn
forall pass.
XOpTy pass
-> LHsType pass
-> Located (IdP pass)
-> LHsType pass
-> HsType pass
HsOpTy XOpTy GhcRn
noExtField LHsType GhcRn
t1 Located (IdP GhcRn)
op2 LHsType GhcRn
t2)
                      (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
op2) Fixity
fix2 LHsType GhcRn
ty21 LHsType GhcRn
ty22 SrcSpan
loc2 }

mkHsOpTyRn LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 Name
pp_op1 Fixity
fix1 LHsType GhcRn
ty1 (LHsType GhcRn -> Located (SrcSpanLess (LHsType GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc2 (HsFunTy _ ty21 ty22))
  = (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> SrcSpan
-> RnM (HsType GhcRn)
mk_hs_op_ty LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 Name
pp_op1 Fixity
fix1 LHsType GhcRn
ty1
                (XFunTy GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcRn
NoExtField
noExtField) Name
funTyConName Fixity
funTyFixity LHsType GhcRn
ty21 LHsType GhcRn
ty22 SrcSpan
loc2

mkHsOpTyRn LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 Name
_ Fixity
_ LHsType GhcRn
ty1 LHsType GhcRn
ty2              -- Default case, no rearrangment
  = HsType GhcRn -> RnM (HsType GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 LHsType GhcRn
ty1 LHsType GhcRn
ty2)

---------------
mk_hs_op_ty :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
            -> Name -> Fixity -> LHsType GhcRn
            -> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
            -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> SrcSpan
            -> RnM (HsType GhcRn)
mk_hs_op_ty :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> SrcSpan
-> RnM (HsType GhcRn)
mk_hs_op_ty LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 Name
op1 Fixity
fix1 LHsType GhcRn
ty1
            LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk2 Name
op2 Fixity
fix2 LHsType GhcRn
ty21 LHsType GhcRn
ty22 SrcSpan
loc2
  | Bool
nofix_error     = do { (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (Name -> OpName
NormalOp Name
op1,Fixity
fix1) (Name -> OpName
NormalOp Name
op2,Fixity
fix2)
                         ; HsType GhcRn -> RnM (HsType GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 LHsType GhcRn
ty1 (SrcSpan -> SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc2 (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk2 LHsType GhcRn
ty21 LHsType GhcRn
ty22))) }
  | Bool
associate_right = HsType GhcRn -> RnM (HsType GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 LHsType GhcRn
ty1 (SrcSpan -> SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc2 (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk2 LHsType GhcRn
ty21 LHsType GhcRn
ty22)))
  | Bool
otherwise       = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
                           HsType GhcRn
new_ty <- (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name
-> Fixity
-> LHsType GhcRn
-> LHsType GhcRn
-> RnM (HsType GhcRn)
mkHsOpTyRn LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk1 Name
op1 Fixity
fix1 LHsType GhcRn
ty1 LHsType GhcRn
ty21
                         ; HsType GhcRn -> RnM (HsType GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
mk2 (SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LHsType GhcRn)
HsType GhcRn
new_ty) LHsType GhcRn
ty22) }
  where
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2


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

-- (e11 `op1` e12) `op2` e2
mkOpAppRn :: LHsExpr GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsExpr GhcRn -> RnM (HsExpr GhcRn)
mkOpAppRn e1 :: LHsExpr GhcRn
e1@(LHsExpr GhcRn -> Located (SrcSpanLess (LHsExpr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (OpApp fix1 e11 op1 e12)) LHsExpr GhcRn
op2 Fixity
fix2 LHsExpr GhcRn
e2
  | Bool
nofix_error
  = do (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op1,Fixity
XOpApp GhcRn
fix1) (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op2,Fixity
fix2)
       HsExpr GhcRn -> RnM (HsExpr GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpApp GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp Fixity
XOpApp GhcRn
fix2 LHsExpr GhcRn
e1 LHsExpr GhcRn
op2 LHsExpr GhcRn
e2)

  | Bool
associate_right = do
    HsExpr GhcRn
new_e <- LHsExpr GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsExpr GhcRn -> RnM (HsExpr GhcRn)
mkOpAppRn LHsExpr GhcRn
e12 LHsExpr GhcRn
op2 Fixity
fix2 LHsExpr GhcRn
e2
    HsExpr GhcRn -> RnM (HsExpr GhcRn)
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
e11 LHsExpr GhcRn
op1 (SrcSpan -> SrcSpanLess (LHsExpr GhcRn) -> LHsExpr GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc' SrcSpanLess (LHsExpr GhcRn)
HsExpr GhcRn
new_e))
  where
    loc' :: SrcSpan
loc'= LHsExpr GhcRn -> LHsExpr GhcRn -> SrcSpan
forall a b. (HasSrcSpan a, HasSrcSpan b) => a -> b -> SrcSpan
combineLocs LHsExpr GhcRn
e12 LHsExpr GhcRn
e2
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
XOpApp GhcRn
fix1 Fixity
fix2

---------------------------
--      (- neg_arg) `op` e2
mkOpAppRn e1 :: LHsExpr GhcRn
e1@(LHsExpr GhcRn -> Located (SrcSpanLess (LHsExpr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (NegApp _ neg_arg 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 (m :: * -> *) a. Monad m => a -> m a
return (XOpApp GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp Fixity
XOpApp GhcRn
fix2 LHsExpr GhcRn
e1 LHsExpr GhcRn
op2 LHsExpr GhcRn
e2)

  | Bool
associate_right
  = do HsExpr GhcRn
new_e <- LHsExpr GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsExpr GhcRn -> RnM (HsExpr GhcRn)
mkOpAppRn LHsExpr GhcRn
neg_arg LHsExpr GhcRn
op2 Fixity
fix2 LHsExpr GhcRn
e2
       HsExpr GhcRn -> RnM (HsExpr GhcRn)
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 (SrcSpan -> SrcSpanLess (LHsExpr GhcRn) -> LHsExpr GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc' SrcSpanLess (LHsExpr GhcRn)
HsExpr GhcRn
new_e) SyntaxExpr GhcRn
neg_name)
  where
    loc' :: SrcSpan
loc' = LHsExpr GhcRn -> LHsExpr GhcRn -> SrcSpan
forall a b. (HasSrcSpan a, HasSrcSpan b) => a -> b -> SrcSpan
combineLocs LHsExpr GhcRn
neg_arg LHsExpr GhcRn
e2
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
negateFixity Fixity
fix2

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

---------------------------
--      Default case
mkOpAppRn LHsExpr GhcRn
e1 LHsExpr GhcRn
op Fixity
fix LHsExpr GhcRn
e2                  -- Default case, no rearrangment
  = ASSERT2( right_op_ok fix (unLoc e2),
             ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
    )
    HsExpr GhcRn -> RnM (HsExpr GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpApp GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp Fixity
XOpApp GhcRn
fix LHsExpr GhcRn
e1 LHsExpr GhcRn
op LHsExpr GhcRn
e2)

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

-- | Name of an operator in an operator application or section
data OpName = NormalOp Name         -- ^ A normal identifier
            | NegateOp              -- ^ Prefix negation
            | UnboundOp UnboundVar  -- ^ An unbound indentifier
            | RecFldOp (AmbiguousFieldOcc GhcRn)
              -- ^ A (possibly ambiguous) record field occurrence

instance Outputable OpName where
  ppr :: OpName -> MsgDoc
ppr (NormalOp Name
n)   = Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n
  ppr OpName
NegateOp       = Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
negateName
  ppr (UnboundOp UnboundVar
uv) = UnboundVar -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr UnboundVar
uv
  ppr (RecFldOp AmbiguousFieldOcc GhcRn
fld) = AmbiguousFieldOcc GhcRn -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr AmbiguousFieldOcc GhcRn
fld

get_op :: LHsExpr GhcRn -> OpName
-- An unbound name could be either HsVar or HsUnboundVar
-- See RnExpr.rnUnboundVar
get_op :: LHsExpr GhcRn -> OpName
get_op (LHsExpr GhcRn -> Located (SrcSpanLess (LHsExpr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (HsVar _ n))         = Name -> OpName
NormalOp (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
n)
get_op (LHsExpr GhcRn -> Located (SrcSpanLess (LHsExpr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (HsUnboundVar _ uv)) = UnboundVar -> OpName
UnboundOp UnboundVar
uv
get_op (LHsExpr GhcRn -> Located (SrcSpanLess (LHsExpr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (HsRecFld _ fld))    = AmbiguousFieldOcc GhcRn -> OpName
RecFldOp AmbiguousFieldOcc GhcRn
fld
get_op LHsExpr GhcRn
other                         = String -> MsgDoc -> OpName
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"get_op" (LHsExpr GhcRn -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr LHsExpr GhcRn
other)

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

-- Parser initially makes negation bind more tightly than any other operator
-- And "deriving" code should respect this (use HsPar if not)
mkNegAppRn :: LHsExpr (GhcPass id) -> SyntaxExpr (GhcPass id)
           -> RnM (HsExpr (GhcPass id))
mkNegAppRn :: LHsExpr (GhcPass id)
-> SyntaxExpr (GhcPass id) -> RnM (HsExpr (GhcPass id))
mkNegAppRn LHsExpr (GhcPass id)
neg_arg SyntaxExpr (GhcPass id)
neg_name
  = ASSERT( not_op_app (unLoc neg_arg) )
    HsExpr (GhcPass id) -> RnM (HsExpr (GhcPass id))
forall (m :: * -> *) a. Monad m => a -> m a
return (XNegApp (GhcPass id)
-> LHsExpr (GhcPass id)
-> SyntaxExpr (GhcPass id)
-> HsExpr (GhcPass id)
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp XNegApp (GhcPass id)
NoExtField
noExtField LHsExpr (GhcPass id)
neg_arg SyntaxExpr (GhcPass id)
neg_name)

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

---------------------------
mkOpFormRn :: LHsCmdTop GhcRn            -- Left operand; already rearranged
          -> LHsExpr GhcRn -> Fixity     -- Operator and fixity
          -> LHsCmdTop GhcRn             -- Right operand (not an infix)
          -> RnM (HsCmd GhcRn)

-- (e11 `op1` e12) `op2` e2
mkOpFormRn :: LHsCmdTop GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsCmdTop GhcRn -> RnM (HsCmd GhcRn)
mkOpFormRn a1 :: LHsCmdTop GhcRn
a1@(LHsCmdTop GhcRn -> Located (SrcSpanLess (LHsCmdTop GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc
                    (HsCmdTop _
                     (dL->L _ (HsCmdArrForm x op1 f (Just fix1)
                        [a11,a12]))))
        LHsExpr GhcRn
op2 Fixity
fix2 LHsCmdTop GhcRn
a2
  | 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 (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
a1, LHsCmdTop GhcRn
a2])

  | Bool
associate_right
  = do HsCmd GhcRn
new_c <- LHsCmdTop GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsCmdTop GhcRn -> RnM (HsCmd GhcRn)
mkOpFormRn LHsCmdTop GhcRn
a12 LHsExpr GhcRn
op2 Fixity
fix2 LHsCmdTop GhcRn
a2
       HsCmd GhcRn -> RnM (HsCmd GhcRn)
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
a11, SrcSpan -> SrcSpanLess (LHsCmdTop GhcRn) -> LHsCmdTop GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (XCmdTop GhcRn -> LHsCmd GhcRn -> HsCmdTop GhcRn
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop [] (SrcSpan -> SrcSpanLess (LHsCmd GhcRn) -> LHsCmd GhcRn
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (LHsCmd GhcRn)
HsCmd GhcRn
new_c))])
        -- TODO: locs are wrong
  where
    (Bool
nofix_error, Bool
associate_right) = Fixity -> Fixity -> (Bool, Bool)
compareFixity Fixity
fix1 Fixity
fix2

--      Default case
mkOpFormRn LHsCmdTop GhcRn
arg1 LHsExpr GhcRn
op Fixity
fix LHsCmdTop GhcRn
arg2                     -- Default case, no rearrangment
  = HsCmd GhcRn -> RnM (HsCmd GhcRn)
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 :: Located Name -> Fixity -> LPat GhcRn -> LPat GhcRn
             -> RnM (Pat GhcRn)

mkConOpPatRn :: Located Name
-> Fixity -> LPat GhcRn -> LPat GhcRn -> RnM (Pat GhcRn)
mkConOpPatRn Located Name
op2 Fixity
fix2 p1 :: LPat GhcRn
p1@(LPat GhcRn -> Located (SrcSpanLess (Located (Pat GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (ConPatIn op1 (InfixCon p11 p12))) LPat GhcRn
p2
  = do  { Fixity
fix1 <- Name -> RnM Fixity
lookupFixityRn (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
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 (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
op1),Fixity
fix1)
                               (Name -> OpName
NormalOp (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
op2),Fixity
fix2)
                ; Pat GhcRn -> RnM (Pat GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (IdP GhcRn) -> HsConPatDetails GhcRn -> Pat GhcRn
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located Name
Located (IdP GhcRn)
op2 (Located (Pat GhcRn)
-> Located (Pat GhcRn)
-> HsConDetails
     (Located (Pat GhcRn)) (HsRecFields GhcRn (Located (Pat GhcRn)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon Located (Pat GhcRn)
LPat GhcRn
p1 Located (Pat GhcRn)
LPat GhcRn
p2)) }

          else if Bool
associate_right then do
                { Pat GhcRn
new_p <- Located Name
-> Fixity -> LPat GhcRn -> LPat GhcRn -> RnM (Pat GhcRn)
mkConOpPatRn Located Name
op2 Fixity
fix2 LPat GhcRn
p12 LPat GhcRn
p2
                ; Pat GhcRn -> RnM (Pat GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (IdP GhcRn) -> HsConPatDetails GhcRn -> Pat GhcRn
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located (IdP GhcRn)
op1 (Located (Pat GhcRn)
-> Located (Pat GhcRn)
-> HsConDetails
     (Located (Pat GhcRn)) (HsRecFields GhcRn (Located (Pat GhcRn)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon Located (Pat GhcRn)
LPat GhcRn
p11 (SrcSpan -> SrcSpanLess (Located (Pat GhcRn)) -> Located (Pat GhcRn)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located (Pat GhcRn))
Pat GhcRn
new_p))) }
                -- XXX loc right?
          else Pat GhcRn -> RnM (Pat GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (IdP GhcRn) -> HsConPatDetails GhcRn -> Pat GhcRn
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located Name
Located (IdP GhcRn)
op2 (Located (Pat GhcRn)
-> Located (Pat GhcRn)
-> HsConDetails
     (Located (Pat GhcRn)) (HsRecFields GhcRn (Located (Pat GhcRn)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon Located (Pat GhcRn)
LPat GhcRn
p1 Located (Pat GhcRn)
LPat GhcRn
p2)) }

mkConOpPatRn Located Name
op Fixity
_ LPat GhcRn
p1 LPat GhcRn
p2                         -- Default case, no rearrangment
  = ASSERT( not_op_pat (unLoc p2) )
    Pat GhcRn -> RnM (Pat GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (IdP GhcRn) -> HsConPatDetails GhcRn -> Pat GhcRn
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located Name
Located (IdP GhcRn)
op (Located (Pat GhcRn)
-> Located (Pat GhcRn)
-> HsConDetails
     (Located (Pat GhcRn)) (HsRecFields GhcRn (Located (Pat GhcRn)))
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon Located (Pat GhcRn)
LPat GhcRn
p1 Located (Pat GhcRn)
LPat GhcRn
p2))

not_op_pat :: Pat GhcRn -> Bool
not_op_pat :: Pat GhcRn -> Bool
not_op_pat (ConPatIn Located (IdP GhcRn)
_ (InfixCon LPat GhcRn
_ LPat GhcRn
_)) = Bool
False
not_op_pat Pat GhcRn
_                           = Bool
True

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

checkPrecMatch :: Name -> MatchGroup GhcRn body -> TcRn ()
checkPrecMatch Name
op (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = (Located [LMatch GhcRn body]
-> Located (SrcSpanLess (Located [LMatch GhcRn body]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located [LMatch GhcRn body])
ms) })
  = (LMatch GhcRn body -> TcRn ()) -> [LMatch GhcRn body] -> TcRn ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LMatch GhcRn body -> TcRn ()
check [LMatch GhcRn body]
SrcSpanLess (Located [LMatch GhcRn body])
ms
  where
    check :: LMatch GhcRn body -> TcRn ()
check (LMatch GhcRn body -> Located (SrcSpanLess (LMatch GhcRn body))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (Match { m_pats = (dL->L l1 p1)
                                   : (dL->L l2 p2)
                                   : _ }))
      = SrcSpan -> TcRn () -> TcRn ()
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
l1 SrcSpan
l2) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
        do Name -> Pat GhcRn -> Bool -> TcRn ()
checkPrec Name
op SrcSpanLess (Located (Pat GhcRn))
Pat GhcRn
p1 Bool
False
           Name -> Pat GhcRn -> Bool -> TcRn ()
checkPrec Name
op SrcSpanLess (Located (Pat GhcRn))
Pat GhcRn
p2 Bool
True

    check LMatch GhcRn body
_ = () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- This can happen.  Consider
        --      a `op` True = ...
        --      op          = ...
        -- The infix flag comes from the first binding of the group
        -- but the second eqn has no args (an error, but not discovered
        -- until the type checker).  So we don't want to crash on the
        -- second eqn.
checkPrecMatch Name
_ (XMatchGroup XXMatchGroup GhcRn body
nec) = NoExtCon -> TcRn ()
forall a. NoExtCon -> a
noExtCon XXMatchGroup GhcRn body
NoExtCon
nec

checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkPrec :: Name -> Pat GhcRn -> Bool -> TcRn ()
checkPrec Name
op (ConPatIn Located (IdP 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 (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
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 (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
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 (m :: * -> *) a. Monad m => a -> m a
return ()

-- Check precedence of (arg op) or (op arg) respectively
-- If arg is itself an operator application, then either
--   (a) its precedence must be higher than that of op
--   (b) its precedency & associativity must be the same as that of op
checkSectionPrec :: FixityDirection -> HsExpr GhcPs
        -> LHsExpr GhcRn -> LHsExpr GhcRn -> RnM ()
checkSectionPrec :: FixityDirection
-> HsExpr GhcPs -> LHsExpr GhcRn -> LHsExpr GhcRn -> TcRn ()
checkSectionPrec FixityDirection
direction HsExpr GhcPs
section LHsExpr GhcRn
op LHsExpr GhcRn
arg
  = case LHsExpr GhcRn -> SrcSpanLess (LHsExpr GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcRn
arg of
        OpApp fix _ op' _ -> OpName -> Fixity -> TcRn ()
go_for_it (LHsExpr GhcRn -> OpName
get_op LHsExpr GhcRn
op') Fixity
XOpApp GhcRn
fix
        NegApp _ _ _      -> OpName -> Fixity -> TcRn ()
go_for_it OpName
NegateOp     Fixity
negateFixity
        SrcSpanLess (LHsExpr GhcRn)
_                 -> () -> TcRn ()
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)

-- | Look up the fixity for an operator name.  Be careful to use
-- 'lookupFieldFixityRn' for (possibly ambiguous) record fields
-- (see #13132).
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 UnboundVar
u) = Name -> RnM Fixity
lookupFixityRn (OccName -> Name
mkUnboundName (UnboundVar -> OccName
unboundVarOcc UnboundVar
u))
lookupFixityOp (RecFldOp AmbiguousFieldOcc GhcRn
f)  = AmbiguousFieldOcc GhcRn -> RnM Fixity
lookupFieldFixityRn AmbiguousFieldOcc GhcRn
f


-- Precedence-related error messages

precParseErr :: (OpName,Fixity) -> (OpName,Fixity) -> RnM ()
precParseErr :: (OpName, Fixity) -> (OpName, Fixity) -> TcRn ()
precParseErr op1 :: (OpName, Fixity)
op1@(OpName
n1,Fixity
_) op2 :: (OpName, Fixity)
op2@(OpName
n2,Fixity
_)
  | OpName -> Bool
is_unbound OpName
n1 Bool -> Bool -> Bool
|| OpName -> Bool
is_unbound OpName
n2
  = () -> TcRn ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()     -- Avoid error cascade
  | Bool
otherwise
  = MsgDoc -> TcRn ()
addErr (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Precedence parsing error")
      Int
4 ([MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text String
"cannot mix", (OpName, Fixity) -> MsgDoc
ppr_opfix (OpName, Fixity)
op1, PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"and"),
               (OpName, Fixity) -> MsgDoc
ppr_opfix (OpName, Fixity)
op2,
               String -> MsgDoc
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 (m :: * -> *) a. Monad m => a -> m a
return ()     -- Avoid error cascade
  | Bool
otherwise
  = MsgDoc -> TcRn ()
addErr (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$ [MsgDoc] -> MsgDoc
vcat [String -> MsgDoc
text String
"The operator" MsgDoc -> MsgDoc -> MsgDoc
<+> (OpName, Fixity) -> MsgDoc
ppr_opfix (OpName, Fixity)
op MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"of a section"),
         Int -> MsgDoc -> MsgDoc
nest Int
4 ([MsgDoc] -> MsgDoc
sep [String -> MsgDoc
text String
"must have lower precedence than that of the operand,",
                      Int -> MsgDoc -> MsgDoc
nest Int
2 (String -> MsgDoc
text String
"namely" MsgDoc -> MsgDoc -> MsgDoc
<+> (OpName, Fixity) -> MsgDoc
ppr_opfix (OpName, Fixity)
arg_op)]),
         Int -> MsgDoc -> MsgDoc
nest Int
4 (String -> MsgDoc
text String
"in the section:" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (HsExpr GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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) -> MsgDoc
ppr_opfix (OpName
op, Fixity
fixity) = MsgDoc
pp_op MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
brackets (Fixity -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Fixity
fixity)
   where
     pp_op :: MsgDoc
pp_op | OpName
NegateOp <- OpName
op = String -> MsgDoc
text String
"prefix `-'"
           | Bool
otherwise      = MsgDoc -> MsgDoc
quotes (OpName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OpName
op)


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

unexpectedTypeSigErr :: LHsSigWcType GhcPs -> SDoc
unexpectedTypeSigErr :: LHsSigWcType GhcPs -> MsgDoc
unexpectedTypeSigErr LHsSigWcType GhcPs
ty
  = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Illegal type signature:" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (LHsSigWcType GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr LHsSigWcType GhcPs
ty))
       Int
2 (String -> MsgDoc
text String
"Type signatures are only allowed in patterns with ScopedTypeVariables")

badKindSigErr :: HsDocContext -> LHsType GhcPs -> TcM ()
badKindSigErr :: HsDocContext -> LHsType GhcPs -> TcRn ()
badKindSigErr HsDocContext
doc (LHsType GhcPs -> Located (SrcSpanLess (LHsType GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LHsType GhcPs)
ty)
  = SrcSpan -> TcRn () -> TcRn ()
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$ MsgDoc -> TcRn ()
addErr (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$
    HsDocContext -> MsgDoc -> MsgDoc
withHsDocContext HsDocContext
doc (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$
    MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Illegal kind signature:" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (HsType GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr SrcSpanLess (LHsType GhcPs)
HsType GhcPs
ty))
       Int
2 (String -> MsgDoc
text String
"Perhaps you intended to use KindSignatures")

dataKindsErr :: RnTyKiEnv -> HsType GhcPs -> SDoc
dataKindsErr :: RnTyKiEnv -> HsType GhcPs -> MsgDoc
dataKindsErr RnTyKiEnv
env HsType GhcPs
thing
  = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Illegal" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
pp_what MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
colon MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (HsType GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsType GhcPs
thing))
       Int
2 (String -> MsgDoc
text String
"Perhaps you intended to use DataKinds")
  where
    pp_what :: MsgDoc
pp_what | RnTyKiEnv -> Bool
isRnKindLevel RnTyKiEnv
env = String -> MsgDoc
text String
"kind"
            | Bool
otherwise          = String -> MsgDoc
text String
"type"

inTypeDoc :: HsType GhcPs -> SDoc
inTypeDoc :: HsType GhcPs -> MsgDoc
inTypeDoc HsType GhcPs
ty = String -> MsgDoc
text String
"In the type" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (HsType GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsType GhcPs
ty)

warnUnusedForAll :: SDoc -> LHsTyVarBndr GhcRn -> FreeVars -> TcM ()
warnUnusedForAll :: MsgDoc -> LHsTyVarBndr GhcRn -> FreeVars -> TcRn ()
warnUnusedForAll MsgDoc
in_doc (LHsTyVarBndr GhcRn -> Located (SrcSpanLess (LHsTyVarBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LHsTyVarBndr GhcRn)
tv) FreeVars
used_names
  = WarningFlag -> TcRn () -> TcRn ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnUnusedForalls (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
    Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsTyVarBndr GhcRn -> IdP GhcRn
forall (p :: Pass). HsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
hsTyVarName SrcSpanLess (LHsTyVarBndr GhcRn)
HsTyVarBndr GhcRn
tv Name -> FreeVars -> Bool
`elemNameSet` FreeVars
used_names) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
    WarnReason -> SrcSpan -> MsgDoc -> TcRn ()
addWarnAt (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnUnusedForalls) SrcSpan
loc (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
forall a b. (a -> b) -> a -> b
$
    [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text String
"Unused quantified type variable" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (HsTyVarBndr GhcRn -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr SrcSpanLess (LHsTyVarBndr GhcRn)
HsTyVarBndr GhcRn
tv)
         , MsgDoc
in_doc ]

opTyErr :: Outputable a => RdrName -> a -> SDoc
opTyErr :: RdrName -> a -> MsgDoc
opTyErr RdrName
op a
overall_ty
  = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Illegal operator" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
op) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"in type") MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
overall_ty))
         Int
2 (String -> MsgDoc
text String
"Use TypeOperators to allow operators in types")

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


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

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

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

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

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

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

Clients of this code can remove duplicates with nubL.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type
synonyms and type family instances.

This is something of a stopgap solution until we can explicitly bind invisible
type/kind variables:

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

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

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

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

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

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

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

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

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

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

-}

-- See Note [Kind and type-variable binders]
-- These lists are guaranteed to preserve left-to-right ordering of
-- the types the variables were extracted from. See also
-- Note [Ordering of implicit variables].
type FreeKiTyVars = [Located RdrName]

-- | A 'FreeKiTyVars' list that is allowed to have duplicate variables.
type FreeKiTyVarsWithDups = FreeKiTyVars

-- | A 'FreeKiTyVars' list that contains no duplicate variables.
type FreeKiTyVarsNoDups   = FreeKiTyVars

filterInScope :: LocalRdrEnv -> FreeKiTyVars -> FreeKiTyVars
filterInScope :: LocalRdrEnv -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
filterInScope LocalRdrEnv
rdr_env = (Located RdrName -> Bool)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. (a -> Bool) -> [a] -> [a]
filterOut (LocalRdrEnv -> RdrName -> Bool
inScope LocalRdrEnv
rdr_env (RdrName -> Bool)
-> (Located RdrName -> RdrName) -> Located RdrName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)

filterInScopeM :: FreeKiTyVars -> RnM FreeKiTyVars
filterInScopeM :: FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
filterInScopeM FreeKiTyVarsWithDups
vars
  = do { LocalRdrEnv
rdr_env <- RnM LocalRdrEnv
getLocalRdrEnv
       ; FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalRdrEnv -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
filterInScope LocalRdrEnv
rdr_env FreeKiTyVarsWithDups
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 -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_tyarg (HsValArg LHsType GhcPs
ty) FreeKiTyVarsWithDups
acc = LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty FreeKiTyVarsWithDups
acc
extract_tyarg (HsTypeArg SrcSpan
_ LHsType GhcPs
ki) FreeKiTyVarsWithDups
acc = LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ki FreeKiTyVarsWithDups
acc
extract_tyarg (HsArgPar SrcSpan
_) FreeKiTyVarsWithDups
acc = FreeKiTyVarsWithDups
acc

extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_tyargs :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_tyargs [LHsTypeArg GhcPs]
args FreeKiTyVarsWithDups
acc = (LHsTypeArg GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups
-> [LHsTypeArg GhcPs]
-> FreeKiTyVarsWithDups
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsTypeArg GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_tyarg FreeKiTyVarsWithDups
acc [LHsTypeArg GhcPs]
args

extractHsTyArgRdrKiTyVarsDup :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups
extractHsTyArgRdrKiTyVarsDup :: [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups
extractHsTyArgRdrKiTyVarsDup [LHsTypeArg GhcPs]
args
  = [LHsTypeArg GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_tyargs [LHsTypeArg GhcPs]
args []

-- | 'extractHsTyRdrTyVars' finds the type/kind variables
--                          of a HsType/HsKind.
-- It's used when making the @forall@s explicit.
-- When the same name occurs multiple times in the types, only the first
-- occurrence is returned.
-- See Note [Kind and type-variable binders]
extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVarsNoDups
extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVars LHsType GhcPs
ty
  = FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. Eq a => [Located a] -> [Located a]
nubL (LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVarsDups LHsType GhcPs
ty)

-- | 'extractHsTyRdrTyVarsDups' finds the type/kind variables
--                              of a HsType/HsKind.
-- It's used when making the @forall@s explicit.
-- When the same name occurs multiple times in the types, all occurrences
-- are returned.
extractHsTyRdrTyVarsDups :: LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVarsDups :: LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVarsDups LHsType GhcPs
ty
  = LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty []

-- | Extracts the free type/kind variables from the kind signature of a HsType.
--   This is used to implicitly quantify over @k@ in @type T = Nothing :: Maybe k@.
-- When the same name occurs multiple times in the type, only the first
-- occurrence is returned, and the left-to-right order of variables is
-- preserved.
-- See Note [Kind and type-variable binders] and
--     Note [Ordering of implicit variables] and
--     Note [Implicit quantification in type synonyms].
extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVarsNoDups
extractHsTyRdrTyVarsKindVars :: LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVarsKindVars (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> SrcSpanLess (LHsType GhcPs)
ty) =
  case SrcSpanLess (LHsType GhcPs)
ty of
    HsParTy _ ty -> LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVarsKindVars LHsType GhcPs
ty
    HsKindSig _ _ ki -> LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVars LHsType GhcPs
ki
    SrcSpanLess (LHsType GhcPs)
_ -> []

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

-- Returns the free kind variables of any explictly-kinded binders, returning
-- variable occurrences in left-to-right order.
-- See Note [Ordering of implicit variables].
-- NB: Does /not/ delete the binders themselves.
--     However duplicates are removed
--     E.g. given  [k1, a:k1, b:k2]
--          the function returns [k1,k2], even though k1 is bound here
extractHsTyVarBndrsKVs :: [LHsTyVarBndr GhcPs] -> FreeKiTyVarsNoDups
extractHsTyVarBndrsKVs :: [LHsTyVarBndr GhcPs] -> FreeKiTyVarsWithDups
extractHsTyVarBndrsKVs [LHsTyVarBndr GhcPs]
tv_bndrs
  = FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. Eq a => [Located a] -> [Located a]
nubL ([LHsTyVarBndr GhcPs] -> FreeKiTyVarsWithDups
extract_hs_tv_bndrs_kvs [LHsTyVarBndr GhcPs]
tv_bndrs)

-- Returns the free kind variables in a type family result signature, returning
-- variable occurrences in left-to-right order.
-- See Note [Ordering of implicit variables].
extractRdrKindSigVars :: LFamilyResultSig GhcPs -> [Located RdrName]
extractRdrKindSigVars :: LFamilyResultSig GhcPs -> FreeKiTyVarsWithDups
extractRdrKindSigVars (LFamilyResultSig GhcPs
-> Located (SrcSpanLess (LFamilyResultSig GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LFamilyResultSig GhcPs)
resultSig)
  | KindSig _ k                              <- SrcSpanLess (LFamilyResultSig GhcPs)
resultSig = LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVars LHsType GhcPs
k
  | TyVarSig _ (dL->L _ (KindedTyVar _ _ k)) <- SrcSpanLess (LFamilyResultSig GhcPs)
resultSig = LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVars LHsType GhcPs
k
  | Bool
otherwise =  []

-- Get type/kind variables mentioned in the kind signature, preserving
-- left-to-right order and without duplicates:
--
--  * data T a (b :: k1) :: k2 -> k1 -> k2 -> Type   -- result: [k2,k1]
--  * data T a (b :: k1)                             -- result: []
--
-- See Note [Ordering of implicit variables].
extractDataDefnKindVars :: HsDataDefn GhcPs ->  FreeKiTyVarsNoDups
extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVarsWithDups
extractDataDefnKindVars (HsDataDefn { dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (LHsType GhcPs)
ksig })
  = FreeKiTyVarsWithDups
-> (LHsType GhcPs -> FreeKiTyVarsWithDups)
-> Maybe (LHsType GhcPs)
-> FreeKiTyVarsWithDups
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] LHsType GhcPs -> FreeKiTyVarsWithDups
extractHsTyRdrTyVars Maybe (LHsType GhcPs)
ksig
extractDataDefnKindVars (XHsDataDefn XXHsDataDefn GhcPs
nec) = NoExtCon -> FreeKiTyVarsWithDups
forall a. NoExtCon -> a
noExtCon XXHsDataDefn GhcPs
NoExtCon
nec

extract_lctxt :: LHsContext GhcPs
              -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lctxt :: LHsContext GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lctxt LHsContext GhcPs
ctxt = [LHsType GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_ltys (LHsContext GhcPs -> SrcSpanLess (LHsContext GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsContext GhcPs
ctxt)

extract_ltys :: [LHsType GhcPs]
             -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_ltys :: [LHsType GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_ltys [LHsType GhcPs]
tys FreeKiTyVarsWithDups
acc = (LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> [LHsType GhcPs] -> FreeKiTyVarsWithDups
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty FreeKiTyVarsWithDups
acc [LHsType GhcPs]
tys

extract_lty :: LHsType GhcPs
            -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty :: LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty (LHsType GhcPs -> Located (SrcSpanLess (LHsType GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LHsType GhcPs)
ty) FreeKiTyVarsWithDups
acc
  = case SrcSpanLess (LHsType GhcPs)
ty of
      HsTyVar _ _  ltv            -> Located RdrName -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_tv Located RdrName
Located (IdP GhcPs)
ltv FreeKiTyVarsWithDups
acc
      HsBangTy _ _ ty             -> LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty FreeKiTyVarsWithDups
acc
      HsRecTy _ flds              -> (LConDeclField GhcPs
 -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups
-> [LConDeclField GhcPs]
-> FreeKiTyVarsWithDups
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty
                                            (LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> (LConDeclField GhcPs -> LHsType GhcPs)
-> LConDeclField GhcPs
-> FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConDeclField GhcPs -> LHsType GhcPs
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type (ConDeclField GhcPs -> LHsType GhcPs)
-> (LConDeclField GhcPs -> ConDeclField GhcPs)
-> LConDeclField GhcPs
-> LHsType GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LConDeclField GhcPs -> ConDeclField GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) FreeKiTyVarsWithDups
acc
                                           [LConDeclField GhcPs]
flds
      HsAppTy _ ty1 ty2           -> LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty1 (FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty2 FreeKiTyVarsWithDups
acc
      HsAppKindTy _ ty k          -> LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty (FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
k FreeKiTyVarsWithDups
acc
      HsListTy _ ty               -> LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty FreeKiTyVarsWithDups
acc
      HsTupleTy _ _ tys           -> [LHsType GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_ltys [LHsType GhcPs]
tys FreeKiTyVarsWithDups
acc
      HsSumTy _ tys               -> [LHsType GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_ltys [LHsType GhcPs]
tys FreeKiTyVarsWithDups
acc
      HsFunTy _ ty1 ty2           -> LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty1 (FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty2 FreeKiTyVarsWithDups
acc
      HsIParamTy _ _ ty           -> LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty FreeKiTyVarsWithDups
acc
      HsOpTy _ ty1 tv ty2         -> Located RdrName -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_tv Located RdrName
Located (IdP GhcPs)
tv (FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty1 (FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty2 FreeKiTyVarsWithDups
acc
      HsParTy _ ty                -> LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty FreeKiTyVarsWithDups
acc
      HsSpliceTy {}               -> FreeKiTyVarsWithDups
acc  -- Type splices mention no tvs
      HsDocTy _ ty _              -> LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty FreeKiTyVarsWithDups
acc
      HsExplicitListTy _ _ tys    -> [LHsType GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_ltys [LHsType GhcPs]
tys FreeKiTyVarsWithDups
acc
      HsExplicitTupleTy _ tys     -> [LHsType GhcPs] -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_ltys [LHsType GhcPs]
tys FreeKiTyVarsWithDups
acc
      HsTyLit _ _                 -> FreeKiTyVarsWithDups
acc
      HsStarTy _ _                -> FreeKiTyVarsWithDups
acc
      HsKindSig _ ty ki           -> LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty (FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ki FreeKiTyVarsWithDups
acc
      HsForAllTy { hst_bndrs = tvs, hst_body = ty }
                                  -> [LHsTyVarBndr GhcPs]
-> FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups
extract_hs_tv_bndrs [LHsTyVarBndr GhcPs]
tvs FreeKiTyVarsWithDups
acc (FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty []
      HsQualTy { hst_ctxt = ctxt, hst_body = ty }
                                  -> LHsContext GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lctxt LHsContext GhcPs
ctxt (FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> a -> b
$
                                     LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty LHsType GhcPs
ty FreeKiTyVarsWithDups
acc
      XHsType {}                  -> FreeKiTyVarsWithDups
acc
      -- We deal with these separately in rnLHsTypeWithWildCards
      HsWildCardTy {}             -> FreeKiTyVarsWithDups
acc

extractHsTvBndrs :: [LHsTyVarBndr GhcPs]
                 -> FreeKiTyVarsWithDups           -- Free in body
                 -> FreeKiTyVarsWithDups       -- Free in result
extractHsTvBndrs :: [LHsTyVarBndr GhcPs]
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extractHsTvBndrs [LHsTyVarBndr GhcPs]
tv_bndrs FreeKiTyVarsWithDups
body_fvs
  = [LHsTyVarBndr GhcPs]
-> FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups
extract_hs_tv_bndrs [LHsTyVarBndr GhcPs]
tv_bndrs [] FreeKiTyVarsWithDups
body_fvs

extract_hs_tv_bndrs :: [LHsTyVarBndr GhcPs]
                    -> FreeKiTyVarsWithDups  -- Accumulator
                    -> FreeKiTyVarsWithDups  -- Free in body
                    -> FreeKiTyVarsWithDups
-- In (forall (a :: Maybe e). a -> b) we have
--     'a' is bound by the forall
--     'b' is a free type variable
--     'e' is a free kind variable
extract_hs_tv_bndrs :: [LHsTyVarBndr GhcPs]
-> FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups
extract_hs_tv_bndrs [LHsTyVarBndr GhcPs]
tv_bndrs FreeKiTyVarsWithDups
acc_vars FreeKiTyVarsWithDups
body_vars
  | [LHsTyVarBndr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr GhcPs]
tv_bndrs = FreeKiTyVarsWithDups
body_vars FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. [a] -> [a] -> [a]
++ FreeKiTyVarsWithDups
acc_vars
  | Bool
otherwise = (Located RdrName -> Bool)
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. (a -> Bool) -> [a] -> [a]
filterOut (Located RdrName -> FreeKiTyVarsWithDups -> Bool
`elemRdr` FreeKiTyVarsWithDups
tv_bndr_rdrs) (FreeKiTyVarsWithDups
bndr_vars FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. [a] -> [a] -> [a]
++ FreeKiTyVarsWithDups
body_vars) FreeKiTyVarsWithDups
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. [a] -> [a] -> [a]
++ FreeKiTyVarsWithDups
acc_vars
    -- NB: delete all tv_bndr_rdrs from bndr_vars as well as body_vars.
    -- See Note [Kind variable scoping]
  where
    bndr_vars :: FreeKiTyVarsWithDups
bndr_vars = [LHsTyVarBndr GhcPs] -> FreeKiTyVarsWithDups
extract_hs_tv_bndrs_kvs [LHsTyVarBndr GhcPs]
tv_bndrs
    tv_bndr_rdrs :: FreeKiTyVarsWithDups
tv_bndr_rdrs = (LHsTyVarBndr GhcPs -> Located RdrName)
-> [LHsTyVarBndr GhcPs] -> FreeKiTyVarsWithDups
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr GhcPs -> Located RdrName
forall (p :: Pass).
LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p))
hsLTyVarLocName [LHsTyVarBndr GhcPs]
tv_bndrs

extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr GhcPs] -> [Located RdrName]
-- Returns the free kind variables of any explictly-kinded binders, returning
-- variable occurrences in left-to-right order.
-- See Note [Ordering of implicit variables].
-- NB: Does /not/ delete the binders themselves.
--     Duplicates are /not/ removed
--     E.g. given  [k1, a:k1, b:k2]
--          the function returns [k1,k2], even though k1 is bound here
extract_hs_tv_bndrs_kvs :: [LHsTyVarBndr GhcPs] -> FreeKiTyVarsWithDups
extract_hs_tv_bndrs_kvs [LHsTyVarBndr GhcPs]
tv_bndrs =
    (LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups)
-> FreeKiTyVarsWithDups -> [LHsType GhcPs] -> FreeKiTyVarsWithDups
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsType GhcPs -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_lty []
          [LHsType GhcPs
k | (LHsTyVarBndr GhcPs -> Located (SrcSpanLess (LHsTyVarBndr GhcPs))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (KindedTyVar _ _ k)) <- [LHsTyVarBndr GhcPs]
tv_bndrs]

extract_tv :: Located RdrName
           -> [Located RdrName] -> [Located RdrName]
extract_tv :: Located RdrName -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
extract_tv Located RdrName
tv FreeKiTyVarsWithDups
acc =
  if RdrName -> Bool
isRdrTyVar (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
tv) then Located RdrName
tvLocated RdrName -> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
forall a. a -> [a] -> [a]
:FreeKiTyVarsWithDups
acc else FreeKiTyVarsWithDups
acc

-- Deletes duplicates in a list of Located things.
--
-- Importantly, this function is stable with respect to the original ordering
-- of things in the list. This is important, as it is a property that GHC
-- relies on to maintain the left-to-right ordering of implicitly quantified
-- type variables.
-- See Note [Ordering of implicit variables].
nubL :: Eq a => [Located a] -> [Located a]
nubL :: [Located a] -> [Located a]
nubL = (Located a -> Located a -> Bool) -> [Located a] -> [Located a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy Located a -> Located a -> Bool
forall a. (HasSrcSpan a, Eq (SrcSpanLess a)) => a -> a -> Bool
eqLocated

elemRdr :: Located RdrName -> [Located RdrName] -> Bool
elemRdr :: Located RdrName -> FreeKiTyVarsWithDups -> Bool
elemRdr Located RdrName
x = (Located RdrName -> Bool) -> FreeKiTyVarsWithDups -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Located RdrName -> Located RdrName -> Bool
forall a. (HasSrcSpan a, Eq (SrcSpanLess a)) => a -> a -> Bool
eqLocated Located RdrName
x)