{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use camelCase" #-}
module GHC.Rename.Pat (
rnPat, rnPats, rnBindPat,
NameMaker, applyNameMaker,
localRecNameMaker, topRecNameMaker,
isTopRecNameMaker,
rnHsRecFields, HsRecFieldContext(..),
rnHsRecUpdFields,
CpsRn, liftCps, liftCpsWithCont,
rnLit, rnOverLit,
) where
import GHC.Prelude
import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr )
import {-# SOURCE #-} GHC.Rename.Splice ( rnSplicePat, rnSpliceTyPat )
import GHC.Hs
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.TcMType ( hsOverLitName )
import GHC.Rename.Env
import GHC.Rename.Fixity
import GHC.Rename.Utils ( newLocalBndrRn, bindLocalNames
, warnUnusedMatches, newLocalBndrRn
, checkUnusedRecordWildcard
, checkDupNames, checkDupAndShadowedNames
, wrapGenSpan, genHsApps, genLHsVar, genHsIntegralLit, delLocalNames, typeAppErr )
import GHC.Rename.HsType
import GHC.Builtin.Names
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Reader
import GHC.Types.Unique.Set
import GHC.Types.Basic
import GHC.Types.SourceText
import GHC.Utils.Misc
import GHC.Data.FastString ( uniqCompareFS )
import GHC.Data.List.SetOps( removeDups )
import GHC.Utils.Outputable
import GHC.Utils.Panic.Plain
import GHC.Types.SrcLoc
import GHC.Types.Literal ( inCharRange )
import GHC.Types.GREInfo ( ConInfo(..), conInfoFields, ConFieldInfo (..) )
import GHC.Builtin.Types ( nilDataCon )
import GHC.Core.DataCon
import GHC.Core.TyCon ( isKindName )
import qualified GHC.LanguageExtensions as LangExt
import Control.Monad ( when, ap, guard, unless )
import Data.Foldable
import Data.Function ( on )
import Data.Functor.Identity ( Identity (..) )
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Ratio
import Control.Monad.Trans.Writer.CPS
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Data.Functor ((<&>))
import GHC.Rename.Doc (rnLHsDoc)
import GHC.Types.Hint
import GHC.Types.Fixity (LexicalFixity(..))
import Data.Coerce
newtype CpsRn b = CpsRn { forall b.
CpsRn b -> forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
unCpsRn :: forall r. (b -> RnM (r, FreeVars))
-> RnM (r, FreeVars) }
deriving ((forall a b. (a -> b) -> CpsRn a -> CpsRn b)
-> (forall a b. a -> CpsRn b -> CpsRn a) -> Functor CpsRn
forall a b. a -> CpsRn b -> CpsRn a
forall a b. (a -> b) -> CpsRn a -> CpsRn b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CpsRn a -> CpsRn b
fmap :: forall a b. (a -> b) -> CpsRn a -> CpsRn b
$c<$ :: forall a b. a -> CpsRn b -> CpsRn a
<$ :: forall a b. a -> CpsRn b -> CpsRn a
Functor)
instance Applicative CpsRn where
pure :: forall a. a -> CpsRn a
pure a
x = (forall r. (a -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn a
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn (\a -> RnM (r, FreeVars)
k -> a -> RnM (r, FreeVars)
k a
x)
<*> :: forall a b. CpsRn (a -> b) -> CpsRn a -> CpsRn b
(<*>) = CpsRn (a -> b) -> CpsRn a -> CpsRn b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad CpsRn where
(CpsRn forall r. (a -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
m) >>= :: forall a b. CpsRn a -> (a -> CpsRn b) -> CpsRn b
>>= a -> CpsRn b
mk = (forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn (\b -> RnM (r, FreeVars)
k -> (a -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
forall r. (a -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
m (\a
v -> CpsRn b -> forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
forall b.
CpsRn b -> forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
unCpsRn (a -> CpsRn b
mk a
v) b -> RnM (r, FreeVars)
k))
runCps :: CpsRn a -> RnM (a, FreeVars)
runCps :: forall a. CpsRn a -> RnM (a, FreeVars)
runCps (CpsRn forall r. (a -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
m) = (a -> RnM (a, FreeVars)) -> RnM (a, FreeVars)
forall r. (a -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
m (\a
r -> (a, FreeVars) -> RnM (a, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, FreeVars
emptyFVs))
liftCps :: RnM a -> CpsRn a
liftCps :: forall a. RnM a -> CpsRn a
liftCps RnM a
rn_thing = (forall r. (a -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn a
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn (\a -> RnM (r, FreeVars)
k -> RnM a
rn_thing RnM a -> (a -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) a
-> (a -> IOEnv (Env TcGblEnv TcLclEnv) b)
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RnM (r, FreeVars)
k)
liftCpsFV :: RnM (a, FreeVars) -> CpsRn a
liftCpsFV :: forall a. RnM (a, FreeVars) -> CpsRn a
liftCpsFV RnM (a, FreeVars)
rn_thing = (forall r. (a -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn a
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn (\a -> RnM (r, FreeVars)
k -> do { (v,fvs1) <- RnM (a, FreeVars)
rn_thing
; (r,fvs2) <- k v
; return (r, fvs1 `plusFV` fvs2) })
liftCpsWithCont :: (forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)) -> CpsRn b
liftCpsWithCont :: forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
liftCpsWithCont = (forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn
wrapSrcSpanCps :: (a -> CpsRn b) -> LocatedA a -> CpsRn (LocatedA b)
wrapSrcSpanCps :: forall a b. (a -> CpsRn b) -> LocatedA a -> CpsRn (LocatedA b)
wrapSrcSpanCps a -> CpsRn b
fn (L EpAnn AnnListItem
loc a
a)
= (forall r. (LocatedA b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn (LocatedA b)
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn (\LocatedA b -> RnM (r, FreeVars)
k -> EpAnn AnnListItem -> RnM (r, FreeVars) -> RnM (r, FreeVars)
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA EpAnn AnnListItem
loc (RnM (r, FreeVars) -> RnM (r, FreeVars))
-> RnM (r, FreeVars) -> RnM (r, FreeVars)
forall a b. (a -> b) -> a -> b
$
CpsRn b -> forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
forall b.
CpsRn b -> forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
unCpsRn (a -> CpsRn b
fn a
a) ((b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
forall a b. (a -> b) -> a -> b
$ \b
v ->
LocatedA b -> RnM (r, FreeVars)
k (EpAnn AnnListItem -> b -> LocatedA b
forall l e. l -> e -> GenLocated l e
L EpAnn AnnListItem
loc b
v))
lookupConCps :: LocatedN RdrName -> CpsRn (LocatedN Name)
lookupConCps :: LocatedN RdrName -> CpsRn (LocatedN Name)
lookupConCps LocatedN RdrName
con_rdr
= (forall r.
(LocatedN Name -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn (LocatedN Name)
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn (\LocatedN Name -> RnM (r, FreeVars)
k -> do { con_name <- LocatedN RdrName -> TcRn (LocatedN Name)
forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnConstr LocatedN RdrName
con_rdr
; (r, fvs) <- k con_name
; return (r, addOneFV fvs (unLoc con_name)) })
data NameMaker
= LamMk
Bool
| LetMk
TopLevelFlag
MiniFixityEnv
topRecNameMaker :: MiniFixityEnv -> NameMaker
topRecNameMaker :: MiniFixityEnv -> NameMaker
topRecNameMaker MiniFixityEnv
fix_env = TopLevelFlag -> MiniFixityEnv -> NameMaker
LetMk TopLevelFlag
TopLevel MiniFixityEnv
fix_env
isTopRecNameMaker :: NameMaker -> Bool
isTopRecNameMaker :: NameMaker -> Bool
isTopRecNameMaker (LetMk TopLevelFlag
TopLevel MiniFixityEnv
_) = Bool
True
isTopRecNameMaker NameMaker
_ = Bool
False
localRecNameMaker :: MiniFixityEnv -> NameMaker
localRecNameMaker :: MiniFixityEnv -> NameMaker
localRecNameMaker MiniFixityEnv
fix_env = TopLevelFlag -> MiniFixityEnv -> NameMaker
LetMk TopLevelFlag
NotTopLevel MiniFixityEnv
fix_env
matchNameMaker :: HsMatchContext fn -> NameMaker
matchNameMaker :: forall fn. HsMatchContext fn -> NameMaker
matchNameMaker HsMatchContext fn
ctxt = Bool -> NameMaker
LamMk Bool
report_unused
where
report_unused :: Bool
report_unused = case HsMatchContext fn
ctxt of
StmtCtxt (HsDoStmt HsDoFlavour
GhciStmtCtxt) -> Bool
False
HsMatchContext fn
ThPatQuote -> Bool
False
HsMatchContext fn
_ -> Bool
True
newPatLName :: NameMaker -> LocatedN RdrName -> CpsRn (LocatedN Name)
newPatLName :: NameMaker -> LocatedN RdrName -> CpsRn (LocatedN Name)
newPatLName NameMaker
name_maker rdr_name :: LocatedN RdrName
rdr_name@(L SrcSpanAnnN
loc RdrName
_)
= do { name <- NameMaker -> LocatedN RdrName -> CpsRn Name
newPatName NameMaker
name_maker LocatedN RdrName
rdr_name
; return (L loc name) }
newPatName :: NameMaker -> LocatedN RdrName -> CpsRn Name
newPatName :: NameMaker -> LocatedN RdrName -> CpsRn Name
newPatName (LamMk Bool
report_unused) LocatedN RdrName
rdr_name
= (forall r. (Name -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn Name
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn (\ Name -> RnM (r, FreeVars)
thing_inside ->
do { name <- LocatedN RdrName -> RnM Name
newLocalBndrRn LocatedN RdrName
rdr_name
; (res, fvs) <- bindLocalNames [name] (thing_inside name)
; when report_unused $ warnUnusedMatches [name] fvs
; return (res, name `delFV` fvs) })
newPatName (LetMk TopLevelFlag
is_top MiniFixityEnv
fix_env) LocatedN RdrName
rdr_name
= (forall r. (Name -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn Name
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn (\ Name -> RnM (r, FreeVars)
thing_inside ->
do { name <- case TopLevelFlag
is_top of
TopLevelFlag
NotTopLevel -> LocatedN RdrName -> RnM Name
newLocalBndrRn LocatedN RdrName
rdr_name
TopLevelFlag
TopLevel -> LocatedN RdrName -> RnM Name
newTopSrcBinder LocatedN RdrName
rdr_name
; bindLocalNames [name] $
addLocalFixities fix_env [name] $
thing_inside name })
{-# INLINE rn_pats_general #-}
rn_pats_general :: Traversable f => HsMatchContextRn
-> f (LPat GhcPs)
-> (f (LPat GhcRn) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
rn_pats_general :: forall (f :: * -> *) r.
Traversable f =>
HsMatchContextRn
-> f (LPat GhcPs)
-> (f (LPat (GhcPass 'Renamed)) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
rn_pats_general HsMatchContextRn
ctxt f (LPat GhcPs)
pats f (LPat (GhcPass 'Renamed)) -> RnM (r, FreeVars)
thing_inside = do
envs_before <- TcRn (GlobalRdrEnv, LocalRdrEnv)
getRdrEnvs
unCpsRn (rn_pats_fun (matchNameMaker ctxt) pats) $ \ f (LocatedA (Pat (GhcPass 'Renamed)))
pats' -> do
let bndrs :: [IdP (GhcPass 'Renamed)]
bndrs = CollectFlag (GhcPass 'Renamed)
-> [LPat (GhcPass 'Renamed)] -> [IdP (GhcPass 'Renamed)]
forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag (GhcPass 'Renamed)
CollVarTyVarBinders (f (LocatedA (Pat (GhcPass 'Renamed)))
-> [LocatedA (Pat (GhcPass 'Renamed))]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (LocatedA (Pat (GhcPass 'Renamed)))
pats')
SDoc
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. SDoc -> TcM a -> TcM a
addErrCtxt SDoc
doc_pat (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
if HsMatchContext (LocatedN Name) -> Bool
forall fn. HsMatchContext fn -> Bool
isPatSynCtxt HsMatchContextRn
HsMatchContext (LocatedN Name)
ctxt
then [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupNames [IdP (GhcPass 'Renamed)]
[Name]
bndrs
else (GlobalRdrEnv, LocalRdrEnv)
-> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupAndShadowedNames (GlobalRdrEnv, LocalRdrEnv)
envs_before [IdP (GhcPass 'Renamed)]
[Name]
bndrs
f (LPat (GhcPass 'Renamed)) -> RnM (r, FreeVars)
thing_inside f (LPat (GhcPass 'Renamed))
f (LocatedA (Pat (GhcPass 'Renamed)))
pats'
where
doc_pat :: SDoc
doc_pat = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsMatchContext (LocatedN Name) -> SDoc
forall fn. Outputable fn => HsMatchContext fn -> SDoc
pprMatchContext HsMatchContextRn
HsMatchContext (LocatedN Name)
ctxt
rn_pats_fun :: NameMaker
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
rn_pats_fun = case HsMatchContextRn
ctxt of
FunRhs{} -> (LocatedA (Pat GhcPs) -> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
mapM ((LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed)))))
-> (NameMaker
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> NameMaker
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameMaker
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed)))
rnLArgPatAndThen
LamAlt HsLamVariant
LamSingle -> (LocatedA (Pat GhcPs) -> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
mapM ((LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed)))))
-> (NameMaker
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> NameMaker
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameMaker
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed)))
rnLArgPatAndThen
LamAlt HsLamVariant
LamCases -> (LocatedA (Pat GhcPs) -> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
mapM ((LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed)))))
-> (NameMaker
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> NameMaker
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameMaker
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed)))
rnLArgPatAndThen
HsMatchContextRn
_ -> (LocatedA (Pat GhcPs) -> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
mapM ((LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed)))))
-> (NameMaker
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> NameMaker
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
NameMaker
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed)))
rnLPatAndThen
rnPats :: HsMatchContextRn
-> [LPat GhcPs]
-> ([LPat GhcRn] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPats :: forall a.
HsMatchContextRn
-> [LPat GhcPs]
-> ([LPat (GhcPass 'Renamed)] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPats = HsMatchContextRn
-> [LPat GhcPs]
-> ([LPat (GhcPass 'Renamed)] -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall (f :: * -> *) r.
Traversable f =>
HsMatchContextRn
-> f (LPat GhcPs)
-> (f (LPat (GhcPass 'Renamed)) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
rn_pats_general
rnPat :: forall a. HsMatchContextRn
-> LPat GhcPs
-> (LPat GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPat :: forall a.
HsMatchContextRn
-> LPat GhcPs
-> (LPat (GhcPass 'Renamed) -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPat
= (HsMatchContext (LocatedN Name)
-> Identity (LocatedA (Pat GhcPs))
-> (Identity (LocatedA (Pat (GhcPass 'Renamed)))
-> RnM (a, FreeVars))
-> RnM (a, FreeVars))
-> HsMatchContext (LocatedN Name)
-> LocatedA (Pat GhcPs)
-> (LocatedA (Pat (GhcPass 'Renamed)) -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
forall a b. Coercible a b => a -> b
coerce (forall (f :: * -> *) r.
Traversable f =>
HsMatchContextRn
-> f (LPat GhcPs)
-> (f (LPat (GhcPass 'Renamed)) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
rn_pats_general @Identity @a)
applyNameMaker :: NameMaker -> LocatedN RdrName -> RnM (LocatedN Name)
applyNameMaker :: NameMaker -> LocatedN RdrName -> TcRn (LocatedN Name)
applyNameMaker NameMaker
mk LocatedN RdrName
rdr = do { (n, _fvs) <- CpsRn (LocatedN Name) -> RnM (LocatedN Name, FreeVars)
forall a. CpsRn a -> RnM (a, FreeVars)
runCps (NameMaker -> LocatedN RdrName -> CpsRn (LocatedN Name)
newPatLName NameMaker
mk LocatedN RdrName
rdr)
; return n }
rnBindPat :: NameMaker
-> LPat GhcPs
-> RnM (LPat GhcRn, FreeVars)
rnBindPat :: NameMaker -> LPat GhcPs -> RnM (LPat (GhcPass 'Renamed), FreeVars)
rnBindPat NameMaker
name_maker LPat GhcPs
pat = CpsRn (LocatedA (Pat (GhcPass 'Renamed)))
-> RnM (LocatedA (Pat (GhcPass 'Renamed)), FreeVars)
forall a. CpsRn a -> RnM (a, FreeVars)
runCps (NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
rnLPatAndThen NameMaker
name_maker LPat GhcPs
pat)
rnLArgPatAndThen :: NameMaker -> LocatedA (Pat GhcPs) -> CpsRn (LocatedA (Pat GhcRn))
rnLArgPatAndThen :: NameMaker
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed)))
rnLArgPatAndThen NameMaker
mk = (Pat GhcPs -> CpsRn (Pat (GhcPass 'Renamed)))
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed)))
forall a b. (a -> CpsRn b) -> LocatedA a -> CpsRn (LocatedA b)
wrapSrcSpanCps Pat GhcPs -> CpsRn (Pat (GhcPass 'Renamed))
rnArgPatAndThen where
rnArgPatAndThen :: Pat GhcPs -> CpsRn (Pat (GhcPass 'Renamed))
rnArgPatAndThen (InvisPat (EpToken "@"
_, Specificity
spec) HsTyPat (NoGhcTc GhcPs)
tp) = do
IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ()
forall a. RnM a -> CpsRn a
liftCps (IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ())
-> IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ()
forall a b. (a -> b) -> a -> b
$ Extension
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl. Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
unlessXOptM Extension
LangExt.TypeAbstractions (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (HsTyPat GhcPs -> TcRnMessage
TcRnIllegalInvisibleTypePattern HsTyPat (NoGhcTc GhcPs)
HsTyPat GhcPs
tp)
tp' <- HsDocContext -> HsTyPat GhcPs -> CpsRn (HsTyPat (GhcPass 'Renamed))
rnHsTyPat HsDocContext
HsTypePatCtx HsTyPat (NoGhcTc GhcPs)
HsTyPat GhcPs
tp
pure (InvisPat spec tp')
rnArgPatAndThen Pat GhcPs
p = NameMaker -> Pat GhcPs -> CpsRn (Pat (GhcPass 'Renamed))
rnPatAndThen NameMaker
mk Pat GhcPs
p
rnLPatsAndThen :: Traversable f => NameMaker -> f (LPat GhcPs) -> CpsRn (f (LPat GhcRn))
rnLPatsAndThen :: forall (f :: * -> *).
Traversable f =>
NameMaker -> f (LPat GhcPs) -> CpsRn (f (LPat (GhcPass 'Renamed)))
rnLPatsAndThen NameMaker
mk = (LocatedA (Pat GhcPs) -> CpsRn (LocatedA (Pat (GhcPass 'Renamed))))
-> f (LocatedA (Pat GhcPs))
-> CpsRn (f (LocatedA (Pat (GhcPass 'Renamed))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse (NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
rnLPatAndThen NameMaker
mk)
{-# SPECIALISE rnLPatsAndThen :: NameMaker -> [LPat GhcPs] -> CpsRn [LPat GhcRn] #-}
{-# SPECIALISE rnLPatsAndThen :: NameMaker -> NE.NonEmpty (LPat GhcPs) -> CpsRn (NE.NonEmpty (LPat GhcRn)) #-}
rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn)
rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
rnLPatAndThen NameMaker
nm LPat GhcPs
lpat = (Pat GhcPs -> CpsRn (Pat (GhcPass 'Renamed)))
-> LocatedA (Pat GhcPs)
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed)))
forall a b. (a -> CpsRn b) -> LocatedA a -> CpsRn (LocatedA b)
wrapSrcSpanCps (NameMaker -> Pat GhcPs -> CpsRn (Pat (GhcPass 'Renamed))
rnPatAndThen NameMaker
nm) LPat GhcPs
LocatedA (Pat GhcPs)
lpat
rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn)
rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat (GhcPass 'Renamed))
rnPatAndThen NameMaker
_ (WildPat XWildPat GhcPs
_) = Pat (GhcPass 'Renamed) -> CpsRn (Pat (GhcPass 'Renamed))
forall a. a -> CpsRn a
forall (m :: * -> *) a. Monad m => a -> m a
return (XWildPat (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
forall p. XWildPat p -> Pat p
WildPat XWildPat (GhcPass 'Renamed)
NoExtField
noExtField)
rnPatAndThen NameMaker
mk (ParPat XParPat GhcPs
_ LPat GhcPs
pat) =
do { pat' <- NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
rnLPatAndThen NameMaker
mk LPat GhcPs
pat
; return (ParPat noExtField pat') }
rnPatAndThen NameMaker
mk (LazyPat XLazyPat GhcPs
_ LPat GhcPs
pat) = do { pat' <- NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
rnLPatAndThen NameMaker
mk LPat GhcPs
pat
; return (LazyPat noExtField pat') }
rnPatAndThen NameMaker
mk (BangPat XBangPat GhcPs
_ LPat GhcPs
pat) = do { pat' <- NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
rnLPatAndThen NameMaker
mk LPat GhcPs
pat
; return (BangPat noExtField pat') }
rnPatAndThen NameMaker
mk (VarPat XVarPat GhcPs
x (L SrcSpanAnnN
l RdrName
rdr))
= do { loc <- RnM SrcSpan -> CpsRn SrcSpan
forall a. RnM a -> CpsRn a
liftCps RnM SrcSpan
getSrcSpanM
; name <- newPatName mk (L (noAnnSrcSpan loc) rdr)
; return (VarPat x (L l name)) }
rnPatAndThen NameMaker
mk (SigPat XSigPat GhcPs
_ LPat GhcPs
pat HsPatSigType (NoGhcTc GhcPs)
sig)
= do { sig' <- HsPatSigType GhcPs -> CpsRn (HsPatSigType (GhcPass 'Renamed))
rnHsPatSigTypeAndThen HsPatSigType (NoGhcTc GhcPs)
HsPatSigType GhcPs
sig
; pat' <- rnLPatAndThen mk pat
; return (SigPat noExtField pat' sig' ) }
where
rnHsPatSigTypeAndThen :: HsPatSigType GhcPs -> CpsRn (HsPatSigType GhcRn)
rnHsPatSigTypeAndThen :: HsPatSigType GhcPs -> CpsRn (HsPatSigType (GhcPass 'Renamed))
rnHsPatSigTypeAndThen HsPatSigType GhcPs
sig = (forall r.
(HsPatSigType (GhcPass 'Renamed) -> RnM (r, FreeVars))
-> RnM (r, FreeVars))
-> CpsRn (HsPatSigType (GhcPass 'Renamed))
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
liftCpsWithCont (HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType (GhcPass 'Renamed) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
forall a.
HsPatSigTypeScoping
-> HsDocContext
-> HsPatSigType GhcPs
-> (HsPatSigType (GhcPass 'Renamed) -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnHsPatSigType HsPatSigTypeScoping
AlwaysBind HsDocContext
PatCtx HsPatSigType GhcPs
sig)
rnPatAndThen NameMaker
mk (LitPat XLitPat GhcPs
x HsLit GhcPs
lit)
| HsString XHsString GhcPs
src FastString
s <- HsLit GhcPs
lit
= do { ovlStr <- RnM Bool -> CpsRn Bool
forall a. RnM a -> CpsRn a
liftCps (Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.OverloadedStrings)
; if ovlStr
then rnPatAndThen mk
(mkNPat (noLocA (mkHsIsString src s))
Nothing noAnn)
else normal_lit }
| Bool
otherwise = CpsRn (Pat (GhcPass 'Renamed))
normal_lit
where
normal_lit :: CpsRn (Pat (GhcPass 'Renamed))
normal_lit = do { IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ()
forall a. RnM a -> CpsRn a
liftCps (HsLit GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall p. HsLit p -> IOEnv (Env TcGblEnv TcLclEnv) ()
rnLit HsLit GhcPs
lit); Pat (GhcPass 'Renamed) -> CpsRn (Pat (GhcPass 'Renamed))
forall a. a -> CpsRn a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitPat (GhcPass 'Renamed)
-> HsLit (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
forall p. XLitPat p -> HsLit p -> Pat p
LitPat XLitPat GhcPs
XLitPat (GhcPass 'Renamed)
x (HsLit GhcPs -> HsLit (GhcPass 'Renamed)
forall (p :: Pass) (p' :: Pass).
(XXLit (GhcPass p) ~ DataConCantHappen) =>
HsLit (GhcPass p) -> HsLit (GhcPass p')
convertLit HsLit GhcPs
lit)) }
rnPatAndThen NameMaker
_ (NPat XNPat GhcPs
x (L EpAnn NoEpAnns
l HsOverLit GhcPs
lit) Maybe (SyntaxExpr GhcPs)
mb_neg SyntaxExpr GhcPs
_eq)
= do { (lit', mb_neg') <- RnM
((HsOverLit (GhcPass 'Renamed), Maybe (HsExpr (GhcPass 'Renamed))),
FreeVars)
-> CpsRn
(HsOverLit (GhcPass 'Renamed), Maybe (HsExpr (GhcPass 'Renamed)))
forall a. RnM (a, FreeVars) -> CpsRn a
liftCpsFV (RnM
((HsOverLit (GhcPass 'Renamed), Maybe (HsExpr (GhcPass 'Renamed))),
FreeVars)
-> CpsRn
(HsOverLit (GhcPass 'Renamed), Maybe (HsExpr (GhcPass 'Renamed))))
-> RnM
((HsOverLit (GhcPass 'Renamed), Maybe (HsExpr (GhcPass 'Renamed))),
FreeVars)
-> CpsRn
(HsOverLit (GhcPass 'Renamed), Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ HsOverLit GhcPs
-> RnM
((HsOverLit (GhcPass 'Renamed), Maybe (HsExpr (GhcPass 'Renamed))),
FreeVars)
forall t.
(XXOverLit t ~ DataConCantHappen) =>
HsOverLit t
-> RnM
((HsOverLit (GhcPass 'Renamed), Maybe (HsExpr (GhcPass 'Renamed))),
FreeVars)
rnOverLit HsOverLit GhcPs
lit
; mb_neg'
<- let negative = do { (neg, fvs) <- Name -> RnM (SyntaxExpr (GhcPass 'Renamed), FreeVars)
lookupSyntax Name
negateName
; return (Just neg, fvs) }
positive = (Maybe a, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe a, FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, FreeVars
emptyFVs)
in liftCpsFV $ case (mb_neg , mb_neg') of
(Maybe NoExtField
Nothing, Just HsExpr (GhcPass 'Renamed)
_ ) -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
negative
(Just NoExtField
_ , Maybe (HsExpr (GhcPass 'Renamed))
Nothing) -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
negative
(Maybe NoExtField
Nothing, Maybe (HsExpr (GhcPass 'Renamed))
Nothing) -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall {a}. IOEnv (Env TcGblEnv TcLclEnv) (Maybe a, FreeVars)
positive
(Just NoExtField
_ , Just HsExpr (GhcPass 'Renamed)
_ ) -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall {a}. IOEnv (Env TcGblEnv TcLclEnv) (Maybe a, FreeVars)
positive
; eq' <- liftCpsFV $ lookupSyntax eqName
; return (NPat x (L l lit') mb_neg' eq') }
rnPatAndThen NameMaker
mk (NPlusKPat XNPlusKPat GhcPs
_ XRec GhcPs (IdP GhcPs)
rdr (L EpAnn NoEpAnns
l HsOverLit GhcPs
lit) HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ )
= do { new_name <- NameMaker -> LocatedN RdrName -> CpsRn Name
newPatName NameMaker
mk (LocatedN RdrName -> LocatedN RdrName
forall l l2 a.
(HasLoc l, HasAnnotation l2) =>
GenLocated l a -> GenLocated l2 a
la2la XRec GhcPs (IdP GhcPs)
LocatedN RdrName
rdr)
; (lit', _) <- liftCpsFV $ rnOverLit lit
; minus <- liftCpsFV $ lookupSyntax minusName
; ge <- liftCpsFV $ lookupSyntax geName
; return (NPlusKPat noExtField (L (noAnnSrcSpan $ nameSrcSpan new_name) new_name)
(L l lit') lit' ge minus) }
rnPatAndThen NameMaker
mk (AsPat XAsPat GhcPs
_ XRec GhcPs (IdP GhcPs)
rdr LPat GhcPs
pat)
= do { new_name <- NameMaker -> LocatedN RdrName -> CpsRn (LocatedN Name)
newPatLName NameMaker
mk XRec GhcPs (IdP GhcPs)
LocatedN RdrName
rdr
; pat' <- rnLPatAndThen mk pat
; return (AsPat noExtField new_name pat') }
rnPatAndThen NameMaker
mk p :: Pat GhcPs
p@(ViewPat XViewPat GhcPs
_ LHsExpr GhcPs
expr LPat GhcPs
pat)
= do { IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ()
forall a. RnM a -> CpsRn a
liftCps (IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ())
-> IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ()
forall a b. (a -> b) -> a -> b
$ do { vp_flag <- Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.ViewPatterns
; checkErr vp_flag (TcRnIllegalViewPattern p) }
; expr' <- RnM (LHsExpr (GhcPass 'Renamed), FreeVars)
-> CpsRn (LHsExpr (GhcPass 'Renamed))
forall a. RnM (a, FreeVars) -> CpsRn a
liftCpsFV (RnM (LHsExpr (GhcPass 'Renamed), FreeVars)
-> CpsRn (LHsExpr (GhcPass 'Renamed)))
-> RnM (LHsExpr (GhcPass 'Renamed), FreeVars)
-> CpsRn (LHsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> RnM (LHsExpr (GhcPass 'Renamed), FreeVars)
rnLExpr LHsExpr GhcPs
expr
; pat' <- rnLPatAndThen mk pat
; return (ViewPat Nothing expr' pat') }
rnPatAndThen NameMaker
mk (ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
con HsConPatDetails GhcPs
args)
= case LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
con RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> RdrName
nameRdrName (DataCon -> Name
dataConName DataCon
nilDataCon) of
Bool
True -> do { ol_flag <- RnM Bool -> CpsRn Bool
forall a. RnM a -> CpsRn a
liftCps (RnM Bool -> CpsRn Bool) -> RnM Bool -> CpsRn Bool
forall a b. (a -> b) -> a -> b
$ Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.OverloadedLists
; if ol_flag then rnPatAndThen mk (ListPat noAnn [])
else rnConPatAndThen mk con args}
Bool
False -> NameMaker
-> LocatedN RdrName
-> HsConPatDetails GhcPs
-> CpsRn (Pat (GhcPass 'Renamed))
rnConPatAndThen NameMaker
mk XRec GhcPs (ConLikeP GhcPs)
LocatedN RdrName
con HsConPatDetails GhcPs
args
rnPatAndThen NameMaker
mk (ListPat XListPat GhcPs
_ [LPat GhcPs]
pats)
= do { opt_OverloadedLists <- RnM Bool -> CpsRn Bool
forall a. RnM a -> CpsRn a
liftCps (RnM Bool -> CpsRn Bool) -> RnM Bool -> CpsRn Bool
forall a b. (a -> b) -> a -> b
$ Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.OverloadedLists
; pats' <- rnLPatsAndThen mk pats
; if not opt_OverloadedLists
then return (ListPat noExtField pats')
else
do { (to_list_name,_) <- liftCps $ lookupSyntaxName toListName
; (from_list_n_name,_) <- liftCps $ lookupSyntaxName fromListNName
; let
lit_n = Int -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit ([LocatedA (Pat GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LPat GhcPs]
[LocatedA (Pat GhcPs)]
pats)
hs_lit = IntegralLit -> LocatedAn AnnListItem (HsExpr (GhcPass 'Renamed))
forall an.
NoAnn an =>
IntegralLit -> LocatedAn an (HsExpr (GhcPass 'Renamed))
genHsIntegralLit IntegralLit
lit_n
inverse = Name -> [LHsExpr (GhcPass 'Renamed)] -> HsExpr (GhcPass 'Renamed)
genHsApps Name
from_list_n_name [LHsExpr (GhcPass 'Renamed)
LocatedAn AnnListItem (HsExpr (GhcPass 'Renamed))
hs_lit]
rn_list_pat = XListPat (GhcPass 'Renamed)
-> [LPat (GhcPass 'Renamed)] -> Pat (GhcPass 'Renamed)
forall p. XListPat p -> [LPat p] -> Pat p
ListPat XListPat (GhcPass 'Renamed)
NoExtField
noExtField [LPat (GhcPass 'Renamed)]
[LocatedA (Pat (GhcPass 'Renamed))]
pats'
exp_expr = Name -> LHsExpr (GhcPass 'Renamed)
genLHsVar Name
to_list_name
exp_list_pat = XViewPat (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed)
-> LPat (GhcPass 'Renamed)
-> Pat (GhcPass 'Renamed)
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just HsExpr (GhcPass 'Renamed)
inverse) LHsExpr (GhcPass 'Renamed)
exp_expr (Pat (GhcPass 'Renamed) -> LocatedA (Pat (GhcPass 'Renamed))
forall e a. HasAnnotation e => a -> GenLocated e a
wrapGenSpan Pat (GhcPass 'Renamed)
rn_list_pat)
; return $ mkExpandedPat rn_list_pat exp_list_pat }}
rnPatAndThen NameMaker
mk (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
boxed)
= do { pats' <- NameMaker -> [LPat GhcPs] -> CpsRn [LPat (GhcPass 'Renamed)]
forall (f :: * -> *).
Traversable f =>
NameMaker -> f (LPat GhcPs) -> CpsRn (f (LPat (GhcPass 'Renamed)))
rnLPatsAndThen NameMaker
mk [LPat GhcPs]
pats
; return (TuplePat noExtField pats' boxed) }
rnPatAndThen NameMaker
mk (OrPat XOrPat GhcPs
_ NonEmpty (LPat GhcPs)
pats)
= do { loc <- RnM SrcSpan -> CpsRn SrcSpan
forall a. RnM a -> CpsRn a
liftCps RnM SrcSpan
getSrcSpanM
; pats' <- rnLPatsAndThen mk pats
; let bndrs = CollectFlag (GhcPass 'Renamed)
-> [LPat (GhcPass 'Renamed)] -> [IdP (GhcPass 'Renamed)]
forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag (GhcPass 'Renamed)
CollVarTyVarBinders (NonEmpty (LocatedA (Pat (GhcPass 'Renamed)))
-> [LocatedA (Pat (GhcPass 'Renamed))]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LocatedA (Pat (GhcPass 'Renamed)))
pats')
; liftCps $ setSrcSpan loc $ checkErr (null bndrs) $
TcRnOrPatBindsVariables (NE.fromList (ordNubOn getOccName bndrs))
; return (OrPat noExtField pats') }
rnPatAndThen NameMaker
mk (SumPat XSumPat GhcPs
_ LPat GhcPs
pat Int
alt Int
arity)
= do { pat <- NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
rnLPatAndThen NameMaker
mk LPat GhcPs
pat
; return (SumPat noExtField pat alt arity)
}
rnPatAndThen NameMaker
mk (SplicePat XSplicePat GhcPs
_ HsUntypedSplice GhcPs
splice)
= do { eith <- RnM
((HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LPat GhcPs)),
FreeVars)
-> CpsRn
(HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LPat GhcPs))
forall a. RnM (a, FreeVars) -> CpsRn a
liftCpsFV (RnM
((HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LPat GhcPs)),
FreeVars)
-> CpsRn
(HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LPat GhcPs)))
-> RnM
((HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LPat GhcPs)),
FreeVars)
-> CpsRn
(HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LPat GhcPs))
forall a b. (a -> b) -> a -> b
$ HsUntypedSplice GhcPs
-> RnM
((HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LPat GhcPs)),
FreeVars)
rnSplicePat HsUntypedSplice GhcPs
splice
; case eith of
(HsUntypedSplice (GhcPass 'Renamed)
rn_splice, HsUntypedSpliceTop ThModFinalizers
mfs LPat GhcPs
pat) ->
LPat (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
LocatedA (Pat (GhcPass 'Renamed)) -> Pat (GhcPass 'Renamed)
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Pat (GhcPass p)
gParPat (LocatedA (Pat (GhcPass 'Renamed)) -> Pat (GhcPass 'Renamed))
-> (LocatedA (Pat (GhcPass 'Renamed))
-> LocatedA (Pat (GhcPass 'Renamed)))
-> LocatedA (Pat (GhcPass 'Renamed))
-> Pat (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Pat (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed))
-> LocatedA (Pat (GhcPass 'Renamed))
-> LocatedA (Pat (GhcPass 'Renamed))
forall a b.
(a -> b)
-> GenLocated (EpAnn AnnListItem) a
-> GenLocated (EpAnn AnnListItem) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsUntypedSpliceResult (Pat (GhcPass 'Renamed))
-> HsUntypedSplice (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed))
-> HsUntypedSplice (GhcPass 'Renamed)
-> HsUntypedSpliceResult (Pat (GhcPass 'Renamed))
-> Pat (GhcPass 'Renamed)
forall a b c. (a -> b -> c) -> b -> a -> c
flip XSplicePat (GhcPass 'Renamed)
-> HsUntypedSplice (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
HsUntypedSpliceResult (Pat (GhcPass 'Renamed))
-> HsUntypedSplice (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
forall p. XSplicePat p -> HsUntypedSplice p -> Pat p
SplicePat HsUntypedSplice (GhcPass 'Renamed)
rn_splice (HsUntypedSpliceResult (Pat (GhcPass 'Renamed))
-> Pat (GhcPass 'Renamed))
-> (Pat (GhcPass 'Renamed)
-> HsUntypedSpliceResult (Pat (GhcPass 'Renamed)))
-> Pat (GhcPass 'Renamed)
-> Pat (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThModFinalizers
-> Pat (GhcPass 'Renamed)
-> HsUntypedSpliceResult (Pat (GhcPass 'Renamed))
forall thing.
ThModFinalizers -> thing -> HsUntypedSpliceResult thing
HsUntypedSpliceTop ThModFinalizers
mfs)) (LocatedA (Pat (GhcPass 'Renamed)) -> Pat (GhcPass 'Renamed))
-> CpsRn (LocatedA (Pat (GhcPass 'Renamed)))
-> CpsRn (Pat (GhcPass 'Renamed))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
rnLPatAndThen NameMaker
mk LPat GhcPs
pat
(HsUntypedSplice (GhcPass 'Renamed)
rn_splice, HsUntypedSpliceNested Name
splice_name) -> Pat (GhcPass 'Renamed) -> CpsRn (Pat (GhcPass 'Renamed))
forall a. a -> CpsRn a
forall (m :: * -> *) a. Monad m => a -> m a
return (XSplicePat (GhcPass 'Renamed)
-> HsUntypedSplice (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
forall p. XSplicePat p -> HsUntypedSplice p -> Pat p
SplicePat (Name -> HsUntypedSpliceResult (Pat (GhcPass 'Renamed))
forall thing. Name -> HsUntypedSpliceResult thing
HsUntypedSpliceNested Name
splice_name) HsUntypedSplice (GhcPass 'Renamed)
rn_splice)
}
rnPatAndThen NameMaker
_ (EmbTyPat XEmbTyPat GhcPs
_ HsTyPat (NoGhcTc GhcPs)
tp)
= do { tp' <- HsDocContext -> HsTyPat GhcPs -> CpsRn (HsTyPat (GhcPass 'Renamed))
rnHsTyPat HsDocContext
HsTypePatCtx HsTyPat (NoGhcTc GhcPs)
HsTyPat GhcPs
tp
; return (EmbTyPat noExtField tp') }
rnPatAndThen NameMaker
_ (InvisPat (EpToken "@"
_, Specificity
spec) HsTyPat (NoGhcTc GhcPs)
tp)
= do { IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ()
forall a. RnM a -> CpsRn a
liftCps (IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ())
-> IOEnv (Env TcGblEnv TcLclEnv) () -> CpsRn ()
forall a b. (a -> b) -> a -> b
$ TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (HsTyPat GhcPs -> TcRnMessage
TcRnMisplacedInvisPat HsTyPat (NoGhcTc GhcPs)
HsTyPat GhcPs
tp)
; tp' <- HsDocContext -> HsTyPat GhcPs -> CpsRn (HsTyPat (GhcPass 'Renamed))
rnHsTyPat HsDocContext
HsTypePatCtx HsTyPat (NoGhcTc GhcPs)
HsTyPat GhcPs
tp
; return (InvisPat spec tp')
}
rnConPatAndThen :: NameMaker
-> LocatedN RdrName
-> HsConPatDetails GhcPs
-> CpsRn (Pat GhcRn)
rnConPatAndThen :: NameMaker
-> LocatedN RdrName
-> HsConPatDetails GhcPs
-> CpsRn (Pat (GhcPass 'Renamed))
rnConPatAndThen NameMaker
mk LocatedN RdrName
con (PrefixCon [HsConPatTyArg (NoGhcTc GhcPs)]
tyargs [LPat GhcPs]
pats)
= do { con' <- LocatedN RdrName -> CpsRn (LocatedN Name)
lookupConCps LocatedN RdrName
con
; liftCps check_lang_exts
; tyargs' <- mapM rnConPatTyArg tyargs
; pats' <- rnLPatsAndThen mk pats
; return $ ConPat
{ pat_con_ext = noExtField
, pat_con = con'
, pat_args = PrefixCon tyargs' pats'
}
}
where
check_lang_exts :: RnM ()
check_lang_exts :: IOEnv (Env TcGblEnv TcLclEnv) ()
check_lang_exts =
Maybe (HsConPatTyArg GhcPs)
-> (HsConPatTyArg GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([HsConPatTyArg GhcPs] -> Maybe (HsConPatTyArg GhcPs)
forall a. [a] -> Maybe a
listToMaybe [HsConPatTyArg (NoGhcTc GhcPs)]
[HsConPatTyArg GhcPs]
tyargs) ((HsConPatTyArg GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> (HsConPatTyArg GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ \ HsConPatTyArg GhcPs
arg ->
do { type_abs <- Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeAbstractions
; type_app <- xoptM LangExt.TypeApplications
; scoped_tvs <- xoptM LangExt.ScopedTypeVariables
; if | type_abs -> return ()
| type_app && scoped_tvs -> addDiagnostic TcRnDeprecatedInvisTyArgInConPat
| otherwise -> addErrTc $ TcRnTypeApplicationsDisabled (TypeApplicationInPattern arg)
}
rnConPatTyArg :: HsConPatTyArg GhcPs -> CpsRn (HsConPatTyArg (GhcPass 'Renamed))
rnConPatTyArg (HsConPatTyArg XConPatTyArg GhcPs
_ HsTyPat GhcPs
t) = do
t' <- HsDocContext -> HsTyPat GhcPs -> CpsRn (HsTyPat (GhcPass 'Renamed))
rnHsTyPat HsDocContext
HsTypePatCtx HsTyPat GhcPs
t
return (HsConPatTyArg noExtField t')
rnConPatAndThen NameMaker
mk LocatedN RdrName
con (InfixCon LPat GhcPs
pat1 LPat GhcPs
pat2)
= do { con' <- LocatedN RdrName -> CpsRn (LocatedN Name)
lookupConCps LocatedN RdrName
con
; pat1' <- rnLPatAndThen mk pat1
; pat2' <- rnLPatAndThen mk pat2
; fixity <- liftCps $ lookupFixityRn (unLoc con')
; liftCps $ mkConOpPatRn con' fixity pat1' pat2' }
rnConPatAndThen NameMaker
mk LocatedN RdrName
con (RecCon HsRecFields GhcPs (LPat GhcPs)
rpats)
= do { con' <- LocatedN RdrName -> CpsRn (LocatedN Name)
lookupConCps LocatedN RdrName
con
; rpats' <- rnHsRecPatsAndThen mk con' rpats
; return $ ConPat
{ pat_con_ext = noExtField
, pat_con = con'
, pat_args = RecCon rpats'
}
}
checkUnusedRecordWildcardCps :: SrcSpan
-> Maybe [ImplicitFieldBinders]
-> CpsRn ()
checkUnusedRecordWildcardCps :: SrcSpan -> Maybe [ImplicitFieldBinders] -> CpsRn ()
checkUnusedRecordWildcardCps SrcSpan
loc Maybe [ImplicitFieldBinders]
dotdot_names =
(forall r. (() -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn ()
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
CpsRn (\() -> RnM (r, FreeVars)
thing -> do
(r, fvs) <- () -> RnM (r, FreeVars)
thing ()
checkUnusedRecordWildcard loc fvs dotdot_names
return (r, fvs) )
rnHsRecPatsAndThen :: NameMaker
-> LocatedN Name
-> HsRecFields GhcPs (LPat GhcPs)
-> CpsRn (HsRecFields GhcRn (LPat GhcRn))
rnHsRecPatsAndThen :: NameMaker
-> LocatedN Name
-> HsRecFields GhcPs (LPat GhcPs)
-> CpsRn (HsRecFields (GhcPass 'Renamed) (LPat (GhcPass 'Renamed)))
rnHsRecPatsAndThen NameMaker
mk (L SrcSpanAnnN
_ Name
con)
hs_rec_fields :: HsRecFields GhcPs (LPat GhcPs)
hs_rec_fields@(HsRecFields { rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot = Maybe (XRec GhcPs RecFieldsDotDot)
dd })
= do { flds <- RnM
([GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs)))],
FreeVars)
-> CpsRn
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs)))]
forall a. RnM (a, FreeVars) -> CpsRn a
liftCpsFV (RnM
([GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs)))],
FreeVars)
-> CpsRn
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs)))])
-> RnM
([GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs)))],
FreeVars)
-> CpsRn
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs)))]
forall a b. (a -> b) -> a -> b
$ HsRecFieldContext
-> (SrcSpan -> RdrName -> Pat GhcPs)
-> HsRecFields GhcPs (LocatedA (Pat GhcPs))
-> RnM
([LHsRecField (GhcPass 'Renamed) (LocatedA (Pat GhcPs))], FreeVars)
forall arg.
HsRecFieldContext
-> (SrcSpan -> RdrName -> arg)
-> HsRecFields GhcPs (LocatedA arg)
-> RnM ([LHsRecField (GhcPass 'Renamed) (LocatedA arg)], FreeVars)
rnHsRecFields (Name -> HsRecFieldContext
HsRecFieldPat Name
con) SrcSpan -> IdP GhcPs -> Pat GhcPs
SrcSpan -> RdrName -> Pat GhcPs
forall {p} {l}.
(XVarPat p ~ NoExtField, XRec p (IdP p) ~ GenLocated l (IdP p),
HasAnnotation l) =>
SrcSpan -> IdP p -> Pat p
mkVarPat
HsRecFields GhcPs (LPat GhcPs)
HsRecFields GhcPs (LocatedA (Pat GhcPs))
hs_rec_fields
; flds' <- mapM rn_field (flds `zip` [1..])
; check_unused_wildcard (lHsRecFieldsImplicits flds' <$> unLoc <$> dd)
; return (HsRecFields { rec_ext = noExtField, rec_flds = flds', rec_dotdot = dd }) }
where
mkVarPat :: SrcSpan -> IdP p -> Pat p
mkVarPat SrcSpan
l IdP p
n = XVarPat p -> XRec p (IdP p) -> Pat p
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat p
NoExtField
noExtField (l -> IdP p -> GenLocated l (IdP p)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> l
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
l) IdP p
n)
rn_field :: (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs))),
Int)
-> CpsRn
(GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat (GhcPass 'Renamed)))))
rn_field (L EpAnn AnnListItem
l HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs))
fld, Int
n') =
do { arg' <- NameMaker -> LPat GhcPs -> CpsRn (LPat (GhcPass 'Renamed))
rnLPatAndThen (Maybe (GenLocated EpaLocation RecFieldsDotDot)
-> NameMaker -> RecFieldsDotDot -> NameMaker
forall {a} {l}.
Ord a =>
Maybe (GenLocated l a) -> NameMaker -> a -> NameMaker
nested_mk Maybe (XRec GhcPs RecFieldsDotDot)
Maybe (GenLocated EpaLocation RecFieldsDotDot)
dd NameMaker
mk (Int -> RecFieldsDotDot
RecFieldsDotDot Int
n')) (HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs))
-> LocatedA (Pat GhcPs)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA (Pat GhcPs))
fld)
; return (L l (fld { hfbRHS = arg' })) }
loc :: SrcSpan
loc = SrcSpan
-> (GenLocated EpaLocation RecFieldsDotDot -> SrcSpan)
-> Maybe (GenLocated EpaLocation RecFieldsDotDot)
-> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SrcSpan
noSrcSpan GenLocated EpaLocation RecFieldsDotDot -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA Maybe (XRec GhcPs RecFieldsDotDot)
Maybe (GenLocated EpaLocation RecFieldsDotDot)
dd
check_unused_wildcard :: Maybe [ImplicitFieldBinders] -> CpsRn ()
check_unused_wildcard = case NameMaker
mk of
LetMk{} -> CpsRn () -> Maybe [ImplicitFieldBinders] -> CpsRn ()
forall a b. a -> b -> a
const (() -> CpsRn ()
forall a. a -> CpsRn a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
LamMk{} -> SrcSpan -> Maybe [ImplicitFieldBinders] -> CpsRn ()
checkUnusedRecordWildcardCps SrcSpan
loc
nested_mk :: Maybe (GenLocated l a) -> NameMaker -> a -> NameMaker
nested_mk Maybe (GenLocated l a)
Nothing NameMaker
mk a
_ = NameMaker
mk
nested_mk (Just GenLocated l a
_) mk :: NameMaker
mk@(LetMk {}) a
_ = NameMaker
mk
nested_mk (Just (GenLocated l a -> a
forall l e. GenLocated l e -> e
unLoc -> a
n)) (LamMk Bool
report_unused) a
n'
= Bool -> NameMaker
LamMk (Bool
report_unused Bool -> Bool -> Bool
&& (a
n' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
n))
mkExpandedPat
:: Pat GhcRn
-> Pat GhcRn
-> Pat GhcRn
mkExpandedPat :: Pat (GhcPass 'Renamed)
-> Pat (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
mkExpandedPat Pat (GhcPass 'Renamed)
a Pat (GhcPass 'Renamed)
b = XXPat (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
forall p. XXPat p -> Pat p
XPat (Pat (GhcPass 'Renamed)
-> Pat (GhcPass 'Renamed)
-> HsPatExpansion (Pat (GhcPass 'Renamed)) (Pat (GhcPass 'Renamed))
forall a b. a -> b -> HsPatExpansion a b
HsPatExpanded Pat (GhcPass 'Renamed)
a Pat (GhcPass 'Renamed)
b)
data HsRecFieldContext
= HsRecFieldCon Name
| HsRecFieldPat Name
| HsRecFieldUpd
rnHsRecFields
:: forall arg.
HsRecFieldContext
-> (SrcSpan -> RdrName -> arg)
-> HsRecFields GhcPs (LocatedA arg)
-> RnM ([LHsRecField GhcRn (LocatedA arg)], FreeVars)
rnHsRecFields :: forall arg.
HsRecFieldContext
-> (SrcSpan -> RdrName -> arg)
-> HsRecFields GhcPs (LocatedA arg)
-> RnM ([LHsRecField (GhcPass 'Renamed) (LocatedA arg)], FreeVars)
rnHsRecFields HsRecFieldContext
ctxt SrcSpan -> RdrName -> arg
mk_arg (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [LHsRecField GhcPs (LocatedA arg)]
flds, rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot = Maybe (XRec GhcPs RecFieldsDotDot)
dotdot })
= do { pun_ok <- Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.NamedFieldPuns
; disambig_ok <- xoptM LangExt.DisambiguateRecordFields
; let parent = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
disambig_ok Maybe () -> Maybe Name -> Maybe Name
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Name
mb_con
; flds1 <- mapM (rn_fld pun_ok parent) flds
; mapM_ (addErr . dupFieldErr ctxt) dup_flds
; dotdot_flds <- rn_dotdot dotdot mb_con flds1
; let all_flds | [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
dotdot_flds = [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
flds1
| Bool
otherwise = [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
flds1 [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
-> [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
-> [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
forall a. [a] -> [a] -> [a]
++ [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
dotdot_flds
; return (all_flds, mkFVs (getFieldIds all_flds)) }
where
mb_con :: Maybe Name
mb_con = case HsRecFieldContext
ctxt of
HsRecFieldCon Name
con -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
con
HsRecFieldPat Name
con -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
con
HsRecFieldContext
HsRecFieldUpd -> Maybe Name
forall a. Maybe a
Nothing
rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (LocatedA arg)
-> RnM (LHsRecField GhcRn (LocatedA arg))
rn_fld :: Bool
-> Maybe Name
-> LHsRecField GhcPs (LocatedA arg)
-> RnM
(XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg)))
rn_fld Bool
pun_ok Maybe Name
parent (L EpAnn AnnListItem
l
(HsFieldBind
{ hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS = L EpAnn AnnListItem
loc (FieldOcc XCFieldOcc GhcPs
_ (L SrcSpanAnnN
ll RdrName
lbl))
, hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS = LocatedA arg
arg
, hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun = Bool
pun }))
= do { sel <- EpAnn AnnListItem -> RnM Name -> RnM Name
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA EpAnn AnnListItem
loc (RnM Name -> RnM Name) -> RnM Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ Maybe Name -> RdrName -> RnM Name
lookupRecFieldOcc Maybe Name
parent RdrName
lbl
; let arg_rdr = OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => OccName -> OccName
OccName -> OccName
recFieldToVarOcc (OccName -> OccName) -> OccName -> OccName
forall a b. (a -> b) -> a -> b
$ Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
sel
; arg' <- if pun
then do { checkErr pun_ok $
TcRnIllegalFieldPunning (L (locA loc) arg_rdr)
; return $ L (l2l loc) $
mk_arg (locA loc) arg_rdr }
else return arg
; return $ L l $
HsFieldBind
{ hfbAnn = noAnn
, hfbLHS = L loc (FieldOcc arg_rdr (L ll sel))
, hfbRHS = arg'
, hfbPun = pun } }
rn_dotdot :: Maybe (LocatedE RecFieldsDotDot)
-> Maybe Name
-> [LHsRecField GhcRn (LocatedA arg)]
-> RnM [LHsRecField GhcRn (LocatedA arg)]
rn_dotdot :: Maybe (GenLocated EpaLocation RecFieldsDotDot)
-> Maybe Name
-> [XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
-> RnM
[XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
rn_dotdot (Just (L EpaLocation
loc_e (RecFieldsDotDot Int
n))) (Just Name
con) [XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
flds
| Bool -> Bool
not (Name -> Bool
isUnboundName Name
con)
= Bool
-> RnM
[XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
-> RnM
[XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
forall a. HasCallStack => Bool -> a -> a
assert ([XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
flds [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
-> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` Int
n) (RnM
[XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
-> RnM
[XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))])
-> RnM
[XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
-> RnM
[XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
forall a b. (a -> b) -> a -> b
$
do { dd_flag <- Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RecordWildCards
; checkErr dd_flag (needFlagDotDot ctxt)
; (rdr_env, lcl_env) <- getRdrEnvs
; conInfo <- lookupConstructorInfo con
; when (conFieldInfo conInfo == ConHasPositionalArgs) (addErr (TcRnIllegalWildcardsInConstructor con))
; let present_flds = [OccName] -> OccSet
mkOccSet ([OccName] -> OccSet) -> [OccName] -> OccSet
forall a b. (a -> b) -> a -> b
$ (RdrName -> OccName) -> [RdrName] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map RdrName -> OccName
rdrNameOcc ([XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
-> [RdrName]
forall arg. [LHsRecField (GhcPass 'Renamed) arg] -> [RdrName]
getFieldRdrs [XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
flds)
arg_in_scope OccName
lbl = OccName -> RdrName
mkRdrUnqual OccName
lbl RdrName -> LocalRdrEnv -> Bool
`elemLocalRdrEnv` LocalRdrEnv
lcl_env
(dot_dot_fields, dot_dot_gres) =
unzip [ (fl, gre)
| fl <- conInfoFields conInfo
, let lbl = HasDebugCallStack => OccName -> OccName
OccName -> OccName
recFieldToVarOcc (OccName -> OccName) -> OccName -> OccName
forall a b. (a -> b) -> a -> b
$ Name -> OccName
forall name. HasOccName name => name -> OccName
occName (Name -> OccName) -> Name -> OccName
forall a b. (a -> b) -> a -> b
$ FieldLabel -> Name
flSelector FieldLabel
fl
, not (lbl `elemOccSet` present_flds)
, Just gre <- [lookupGRE_FieldLabel rdr_env fl]
, case ctxt of
HsRecFieldCon {} -> OccName -> Bool
arg_in_scope OccName
lbl
HsRecFieldContext
_other -> Bool
True ]
; addUsedGREs NoDeprecationWarnings dot_dot_gres
; let loc = EpaLocation -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpaLocation
loc_e
; let locn = SrcSpan -> EpAnn AnnListItem
forall e. HasAnnotation e => SrcSpan -> e
noAnnSrcSpan SrcSpan
loc
; return [ L (noAnnSrcSpan loc) (HsFieldBind
{ hfbAnn = noAnn
, hfbLHS
= L (noAnnSrcSpan loc) (FieldOcc arg_rdr (L (noAnnSrcSpan loc) sel))
, hfbRHS = L locn (mk_arg loc arg_rdr)
, hfbPun = False })
| fl <- dot_dot_fields
, let sel = FieldLabel -> Name
flSelector FieldLabel
fl
arg_rdr = OccName -> RdrName
mkRdrUnqual
(OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => OccName -> OccName
OccName -> OccName
recFieldToVarOcc
(OccName -> OccName) -> OccName -> OccName
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
sel ] }
rn_dotdot Maybe (GenLocated EpaLocation RecFieldsDotDot)
_dotdot Maybe Name
_mb_con [XRec
(GhcPass 'Renamed)
(HsFieldBind (LFieldOcc (GhcPass 'Renamed)) (LocatedA arg))]
_flds
= [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedA arg))]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
dup_flds :: [NE.NonEmpty RdrName]
([RdrName]
_, [NonEmpty RdrName]
dup_flds) = (RdrName -> RdrName -> Ordering)
-> [RdrName] -> ([RdrName], [NonEmpty RdrName])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups (FastString -> FastString -> Ordering
uniqCompareFS (FastString -> FastString -> Ordering)
-> (RdrName -> FastString) -> RdrName -> RdrName -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (OccName -> FastString
occNameFS (OccName -> FastString)
-> (RdrName -> OccName) -> RdrName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc)) ([LHsRecField GhcPs (LocatedA arg)] -> [IdGhcP 'Parsed]
forall (p :: Pass) arg. [LHsRecField (GhcPass p) arg] -> [IdGhcP p]
getFieldLbls [LHsRecField GhcPs (LocatedA arg)]
flds)
rnHsRecUpdFields
:: [LHsRecUpdField GhcPs GhcPs]
-> RnM (XLHsRecUpdLabels GhcRn, [LHsRecUpdField GhcRn GhcRn], FreeVars)
rnHsRecUpdFields :: [LHsRecUpdField GhcPs GhcPs]
-> RnM
(XLHsRecUpdLabels (GhcPass 'Renamed),
[LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)], FreeVars)
rnHsRecUpdFields [LHsRecUpdField GhcPs GhcPs]
flds
= do { pun_ok <- Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.NamedFieldPuns
; case flds of
{ [] -> TcRnMessage
-> IOEnv
(Env TcGblEnv TcLclEnv)
(NonEmpty (HsRecUpdParent (GhcPass 'Renamed)),
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedAn AnnListItem (HsExpr (GhcPass 'Renamed))))],
FreeVars)
forall a. TcRnMessage -> TcM a
failWithTc TcRnMessage
TcRnEmptyRecordUpdate
; LHsRecUpdField GhcPs GhcPs
fld:[LHsRecUpdField GhcPs GhcPs]
other_flds ->
do { let dup_lbls :: [NE.NonEmpty RdrName]
([RdrName]
_, [NonEmpty RdrName]
dup_lbls) = (RdrName -> RdrName -> Ordering)
-> [RdrName] -> ([RdrName], [NonEmpty RdrName])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups (FastString -> FastString -> Ordering
uniqCompareFS (FastString -> FastString -> Ordering)
-> (RdrName -> FastString) -> RdrName -> RdrName -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (OccName -> FastString
occNameFS (OccName -> FastString)
-> (RdrName -> OccName) -> RdrName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc))
((GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs)) (LHsExpr GhcPs))
-> RdrName)
-> [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs)) (LHsExpr GhcPs))]
-> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (LocatedN RdrName -> RdrName)
-> (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs)) (LHsExpr GhcPs))
-> LocatedN RdrName)
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs)) (LHsExpr GhcPs))
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsRecUpdField GhcPs GhcPs -> LocatedN RdrName
GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs)) (LHsExpr GhcPs))
-> LocatedN RdrName
forall (p :: Pass) q.
IsPass p =>
LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl) [LHsRecUpdField GhcPs GhcPs]
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs)) (LHsExpr GhcPs))]
flds)
; (NonEmpty RdrName -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [NonEmpty RdrName] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> (NonEmpty RdrName -> TcRnMessage)
-> NonEmpty RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecFieldContext -> NonEmpty RdrName -> TcRnMessage
dupFieldErr HsRecFieldContext
HsRecFieldUpd) [NonEmpty RdrName]
dup_lbls
; possible_parents <- NonEmpty (LHsRecUpdField GhcPs GhcPs)
-> RnM (NonEmpty (HsRecUpdParent (GhcPass 'Renamed)))
lookupRecUpdFields (LHsRecUpdField GhcPs GhcPs
GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs))
(GenLocated (EpAnn AnnListItem) (HsExpr GhcPs)))
fld GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs))
(GenLocated (EpAnn AnnListItem) (HsExpr GhcPs)))
-> [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs))
(GenLocated (EpAnn AnnListItem) (HsExpr GhcPs)))]
-> NonEmpty
(GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs))
(GenLocated (EpAnn AnnListItem) (HsExpr GhcPs))))
forall a. a -> [a] -> NonEmpty a
NE.:| [LHsRecUpdField GhcPs GhcPs]
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc GhcPs))
(GenLocated (EpAnn AnnListItem) (HsExpr GhcPs)))]
other_flds)
; let mb_unambig_lbls :: Maybe [FieldLabel]
fvs :: FreeVars
(mb_unambig_lbls, fvs) =
case possible_parents of
RnRecUpdParent { rnRecUpdLabels :: HsRecUpdParent (GhcPass 'Renamed) -> NonEmpty FieldGlobalRdrElt
rnRecUpdLabels = NonEmpty FieldGlobalRdrElt
gres } NE.:| []
| let lbls :: [FieldLabel]
lbls = (FieldGlobalRdrElt -> FieldLabel)
-> [FieldGlobalRdrElt] -> [FieldLabel]
forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => FieldGlobalRdrElt -> FieldLabel
FieldGlobalRdrElt -> FieldLabel
fieldGRELabel ([FieldGlobalRdrElt] -> [FieldLabel])
-> [FieldGlobalRdrElt] -> [FieldLabel]
forall a b. (a -> b) -> a -> b
$ NonEmpty FieldGlobalRdrElt -> [FieldGlobalRdrElt]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FieldGlobalRdrElt
gres
-> ( [FieldLabel] -> Maybe [FieldLabel]
forall a. a -> Maybe a
Just [FieldLabel]
lbls, [Name] -> FreeVars
mkFVs ([Name] -> FreeVars) -> [Name] -> FreeVars
forall a b. (a -> b) -> a -> b
$ (FieldLabel -> Name) -> [FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
flSelector [FieldLabel]
lbls)
NonEmpty (HsRecUpdParent (GhcPass 'Renamed))
_ -> ( Maybe [FieldLabel]
forall a. Maybe a
Nothing
, [FreeVars] -> FreeVars
plusFVs ([FreeVars] -> FreeVars) -> [FreeVars] -> FreeVars
forall a b. (a -> b) -> a -> b
$ (HsRecUpdParent (GhcPass 'Renamed) -> FreeVars)
-> [HsRecUpdParent (GhcPass 'Renamed)] -> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map ([FreeVars] -> FreeVars
plusFVs ([FreeVars] -> FreeVars)
-> (HsRecUpdParent (GhcPass 'Renamed) -> [FreeVars])
-> HsRecUpdParent (GhcPass 'Renamed)
-> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldGlobalRdrElt -> FreeVars)
-> [FieldGlobalRdrElt] -> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map FieldGlobalRdrElt -> FreeVars
pat_syn_free_vars ([FieldGlobalRdrElt] -> [FreeVars])
-> (HsRecUpdParent (GhcPass 'Renamed) -> [FieldGlobalRdrElt])
-> HsRecUpdParent (GhcPass 'Renamed)
-> [FreeVars]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty FieldGlobalRdrElt -> [FieldGlobalRdrElt]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty FieldGlobalRdrElt -> [FieldGlobalRdrElt])
-> (HsRecUpdParent (GhcPass 'Renamed)
-> NonEmpty FieldGlobalRdrElt)
-> HsRecUpdParent (GhcPass 'Renamed)
-> [FieldGlobalRdrElt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecUpdParent (GhcPass 'Renamed) -> NonEmpty FieldGlobalRdrElt
rnRecUpdLabels)
([HsRecUpdParent (GhcPass 'Renamed)] -> [FreeVars])
-> [HsRecUpdParent (GhcPass 'Renamed)] -> [FreeVars]
forall a b. (a -> b) -> a -> b
$ NonEmpty (HsRecUpdParent (GhcPass 'Renamed))
-> [HsRecUpdParent (GhcPass 'Renamed)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (HsRecUpdParent (GhcPass 'Renamed))
possible_parents
)
; (upd_flds, fvs') <- rn_flds pun_ok mb_unambig_lbls flds
; let all_fvs = FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs'
; return (possible_parents, upd_flds, all_fvs) } } }
where
pat_syn_free_vars :: FieldGlobalRdrElt -> FreeVars
pat_syn_free_vars :: FieldGlobalRdrElt -> FreeVars
pat_syn_free_vars (GRE { gre_info :: forall info. GlobalRdrEltX info -> info
gre_info = GREInfo
info })
| IAmRecField RecFieldInfo
fld_info <- GREInfo
info
, RecFieldInfo { recFieldLabel :: RecFieldInfo -> FieldLabel
recFieldLabel = FieldLabel
fl, recFieldCons :: RecFieldInfo -> UniqSet ConLikeName
recFieldCons = UniqSet ConLikeName
cons } <- RecFieldInfo
fld_info
, (ConLikeName -> Bool) -> UniqSet ConLikeName -> Bool
forall a. (a -> Bool) -> UniqSet a -> Bool
uniqSetAny ConLikeName -> Bool
is_PS UniqSet ConLikeName
cons
= Name -> FreeVars
unitFV (FieldLabel -> Name
flSelector FieldLabel
fl)
pat_syn_free_vars FieldGlobalRdrElt
_
= FreeVars
emptyFVs
is_PS :: ConLikeName -> Bool
is_PS :: ConLikeName -> Bool
is_PS (PatSynName {}) = Bool
True
is_PS (DataConName {}) = Bool
False
rn_flds :: Bool -> Maybe [FieldLabel]
-> [LHsRecUpdField GhcPs GhcPs]
-> RnM ([LHsRecUpdField GhcRn GhcRn], FreeVars)
rn_flds :: Bool
-> Maybe [FieldLabel]
-> [LHsRecUpdField GhcPs GhcPs]
-> RnM
([LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)], FreeVars)
rn_flds Bool
_ Maybe [FieldLabel]
_ [] = ([GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedAn AnnListItem (HsExpr (GhcPass 'Renamed))))],
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedAn AnnListItem (HsExpr (GhcPass 'Renamed))))],
FreeVars)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
emptyFVs)
rn_flds Bool
pun_ok Maybe [FieldLabel]
mb_unambig_lbls
((L EpAnn AnnListItem
l (HsFieldBind { hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS = L EpAnn AnnListItem
loc (FieldOcc XCFieldOcc GhcPs
_ XRec GhcPs (IdP GhcPs)
f)
, hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS = GenLocated (EpAnn AnnListItem) (HsExpr GhcPs)
arg
, hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun = Bool
pun })):[LHsRecUpdField GhcPs GhcPs]
flds)
= do { let lbl :: RdrName
lbl = LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (IdP GhcPs)
LocatedN RdrName
f
; (arg' :: LHsExpr GhcPs) <- if Bool
pun
then do { EpAnn AnnListItem
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA EpAnn AnnListItem
loc (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
Bool -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkErr Bool
pun_ok (Located RdrName -> TcRnMessage
TcRnIllegalFieldPunning (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpAnn AnnListItem
loc) RdrName
lbl))
; let arg_rdr :: RdrName
arg_rdr = OccName -> RdrName
mkRdrUnqual (RdrName -> OccName
rdrNameOcc RdrName
lbl)
; GenLocated (EpAnn AnnListItem) (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated (EpAnn AnnListItem) (HsExpr GhcPs))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn AnnListItem
-> HsExpr GhcPs -> GenLocated (EpAnn AnnListItem) (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> EpAnn AnnListItem
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l EpAnn AnnListItem
loc) (XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l EpAnn AnnListItem
loc) RdrName
arg_rdr))) }
else GenLocated (EpAnn AnnListItem) (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated (EpAnn AnnListItem) (HsExpr GhcPs))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated (EpAnn AnnListItem) (HsExpr GhcPs)
arg
; (arg'', fvs) <- rnLExpr arg'
; let lbl' :: FieldOcc GhcRn
lbl' = case Maybe [FieldLabel]
mb_unambig_lbls of
{ Just (FieldLabel
fl:[FieldLabel]
_) ->
let sel_name :: Name
sel_name = FieldLabel -> Name
flSelector FieldLabel
fl
in XCFieldOcc (GhcPass 'Renamed)
-> LIdP (GhcPass 'Renamed) -> FieldOcc (GhcPass 'Renamed)
forall pass. XCFieldOcc pass -> LIdP pass -> FieldOcc pass
FieldOcc XCFieldOcc (GhcPass 'Renamed)
RdrName
lbl (SrcSpanAnnN -> Name -> LocatedN Name
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l EpAnn AnnListItem
loc) Name
sel_name)
; Maybe [FieldLabel]
_ -> XCFieldOcc (GhcPass 'Renamed)
-> LIdP (GhcPass 'Renamed) -> FieldOcc (GhcPass 'Renamed)
forall pass. XCFieldOcc pass -> LIdP pass -> FieldOcc pass
FieldOcc XCFieldOcc (GhcPass 'Renamed)
RdrName
lbl (SrcSpanAnnN -> Name -> LocatedN Name
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> SrcSpanAnnN
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l EpAnn AnnListItem
loc) (OccName -> Name
mkUnboundName (OccName -> Name) -> OccName -> Name
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
lbl)) }
fld' :: LHsRecUpdField GhcRn GhcRn
fld' = EpAnn AnnListItem
-> HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedAn AnnListItem (HsExpr (GhcPass 'Renamed)))
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
(LocatedAn AnnListItem (HsExpr (GhcPass 'Renamed))))
forall l e. l -> e -> GenLocated l e
L EpAnn AnnListItem
l (HsFieldBind { hfbAnn :: XHsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
hfbAnn = Maybe (EpToken "=")
XHsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
forall a. NoAnn a => a
noAnn
, hfbLHS :: GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))
hfbLHS = EpAnn AnnListItem
-> FieldOcc (GhcPass 'Renamed)
-> GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
L (EpAnn AnnListItem -> EpAnn AnnListItem
forall a b. (HasLoc a, HasAnnotation b) => a -> b
l2l EpAnn AnnListItem
loc) FieldOcc (GhcPass 'Renamed)
lbl'
, hfbRHS :: LocatedAn AnnListItem (HsExpr (GhcPass 'Renamed))
hfbRHS = LocatedAn AnnListItem (HsExpr (GhcPass 'Renamed))
arg''
, hfbPun :: Bool
hfbPun = Bool
pun })
; (flds', fvs') <- rn_flds pun_ok (tail <$> mb_unambig_lbls) flds
; return (fld' : flds', fvs `plusFV` fvs') }
getFieldIds :: [LHsRecField GhcRn arg] -> [Name]
getFieldIds :: forall arg. [LHsRecField (GhcPass 'Renamed) arg] -> [Name]
getFieldIds [LHsRecField (GhcPass 'Renamed) arg]
flds = (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))) arg)
-> Name)
-> [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
arg)]
-> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (HsRecField (GhcPass 'Renamed) arg -> IdGhcP 'Renamed
HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))) arg
-> Name
forall (p :: Pass) arg. HsRecField (GhcPass p) arg -> IdGhcP p
hsRecFieldSel (HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))) arg
-> Name)
-> (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))) arg)
-> HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))) arg)
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))) arg)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))) arg)
-> HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed))) arg
forall l e. GenLocated l e -> e
unLoc) [LHsRecField (GhcPass 'Renamed) arg]
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass 'Renamed)))
arg)]
flds
getFieldRdrs :: [LHsRecField GhcRn arg] -> [RdrName]
getFieldRdrs :: forall arg. [LHsRecField (GhcPass 'Renamed) arg] -> [RdrName]
getFieldRdrs [LHsRecField (GhcPass 'Renamed) arg]
flds = (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)
-> RdrName)
-> [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)]
-> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
map (FieldOcc (GhcPass 'Renamed) -> XCFieldOcc (GhcPass 'Renamed)
FieldOcc (GhcPass 'Renamed) -> RdrName
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt (FieldOcc (GhcPass 'Renamed) -> RdrName)
-> (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)
-> FieldOcc (GhcPass 'Renamed))
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @GhcRn (GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed))
-> FieldOcc (GhcPass 'Renamed))
-> (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)
-> GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)
-> FieldOcc (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg
-> GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed))
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS (HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg
-> GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
-> (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)
-> HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)
-> GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)
-> HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg
forall l e. GenLocated l e -> e
unLoc) [LHsRecField (GhcPass 'Renamed) arg]
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated
(Anno (FieldOcc (GhcPass 'Renamed))) (FieldOcc (GhcPass 'Renamed)))
arg)]
flds
getFieldLbls :: [LHsRecField (GhcPass p) arg] -> [IdGhcP p]
getFieldLbls :: forall (p :: Pass) arg. [LHsRecField (GhcPass p) arg] -> [IdGhcP p]
getFieldLbls [LHsRecField (GhcPass p) arg]
flds
= (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> IdGhcP p)
-> [GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)]
-> [IdGhcP p]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> IdGhcP p)
-> (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> GenLocated (Anno (IdGhcP p)) (IdGhcP p))
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> IdGhcP p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc (GhcPass p) -> LIdP (GhcPass p)
FieldOcc (GhcPass p) -> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
forall pass. FieldOcc pass -> LIdP pass
foLabel (FieldOcc (GhcPass p) -> GenLocated (Anno (IdGhcP p)) (IdGhcP p))
-> (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> FieldOcc (GhcPass p))
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))
-> FieldOcc (GhcPass p)
forall l e. GenLocated l e -> e
unLoc (GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))
-> FieldOcc (GhcPass p))
-> (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p)))
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> FieldOcc (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg
-> GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS (HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg
-> GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p)))
-> (GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)
-> HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg
forall l e. GenLocated l e -> e
unLoc) [LHsRecField (GhcPass p) arg]
[GenLocated
(EpAnn AnnListItem)
(HsFieldBind
(GenLocated (EpAnn AnnListItem) (FieldOcc (GhcPass p))) arg)]
flds
needFlagDotDot :: HsRecFieldContext -> TcRnMessage
needFlagDotDot :: HsRecFieldContext -> TcRnMessage
needFlagDotDot = RecordFieldPart -> TcRnMessage
TcRnIllegalWildcardsInRecord (RecordFieldPart -> TcRnMessage)
-> (HsRecFieldContext -> RecordFieldPart)
-> HsRecFieldContext
-> TcRnMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecFieldContext -> RecordFieldPart
toRecordFieldPart
dupFieldErr :: HsRecFieldContext -> NE.NonEmpty RdrName -> TcRnMessage
dupFieldErr :: HsRecFieldContext -> NonEmpty RdrName -> TcRnMessage
dupFieldErr HsRecFieldContext
ctxt = RecordFieldPart -> NonEmpty RdrName -> TcRnMessage
TcRnDuplicateFieldName (HsRecFieldContext -> RecordFieldPart
toRecordFieldPart HsRecFieldContext
ctxt)
toRecordFieldPart :: HsRecFieldContext -> RecordFieldPart
toRecordFieldPart :: HsRecFieldContext -> RecordFieldPart
toRecordFieldPart (HsRecFieldCon Name
n) = Name -> RecordFieldPart
RecordFieldConstructor Name
n
toRecordFieldPart (HsRecFieldPat Name
n) = Name -> RecordFieldPart
RecordFieldPattern Name
n
toRecordFieldPart (HsRecFieldUpd {}) = RecordFieldPart
RecordFieldUpdate
rnLit :: HsLit p -> RnM ()
rnLit :: forall p. HsLit p -> IOEnv (Env TcGblEnv TcLclEnv) ()
rnLit (HsChar XHsChar p
_ Char
c) = Bool -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkErr (Char -> Bool
inCharRange Char
c) (Char -> TcRnMessage
TcRnCharLiteralOutOfRange Char
c)
rnLit HsLit p
_ = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
generalizeOverLitVal :: OverLitVal -> OverLitVal
generalizeOverLitVal :: OverLitVal -> OverLitVal
generalizeOverLitVal (HsFractional fl :: FractionalLit
fl@(FL {fl_text :: FractionalLit -> SourceText
fl_text=SourceText
src,fl_neg :: FractionalLit -> Bool
fl_neg=Bool
neg,fl_exp :: FractionalLit -> Integer
fl_exp=Integer
e}))
| Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -Integer
100 Bool -> Bool -> Bool
&& Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
100
, let val :: Rational
val = FractionalLit -> Rational
rationalFromFractionalLit FractionalLit
fl
, Rational -> Integer
forall a. Ratio a -> a
denominator Rational
val Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = IntegralLit -> OverLitVal
HsIntegral (IL {il_text :: SourceText
il_text=SourceText
src,il_neg :: Bool
il_neg=Bool
neg,il_value :: Integer
il_value=Rational -> Integer
forall a. Ratio a -> a
numerator Rational
val})
generalizeOverLitVal OverLitVal
lit = OverLitVal
lit
isNegativeZeroOverLit :: (XXOverLit t ~ DataConCantHappen) => HsOverLit t -> Bool
isNegativeZeroOverLit :: forall t. (XXOverLit t ~ DataConCantHappen) => HsOverLit t -> Bool
isNegativeZeroOverLit HsOverLit t
lit
= case HsOverLit t -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit t
lit of
HsIntegral IntegralLit
i -> Integer
0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== IntegralLit -> Integer
il_value IntegralLit
i Bool -> Bool -> Bool
&& IntegralLit -> Bool
il_neg IntegralLit
i
HsFractional FractionalLit
fl -> Rational
0 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== FractionalLit -> Rational
fl_signi FractionalLit
fl Bool -> Bool -> Bool
&& FractionalLit -> Bool
fl_neg FractionalLit
fl
OverLitVal
_ -> Bool
False
rnOverLit :: (XXOverLit t ~ DataConCantHappen) => HsOverLit t ->
RnM ((HsOverLit GhcRn, Maybe (HsExpr GhcRn)), FreeVars)
rnOverLit :: forall t.
(XXOverLit t ~ DataConCantHappen) =>
HsOverLit t
-> RnM
((HsOverLit (GhcPass 'Renamed), Maybe (HsExpr (GhcPass 'Renamed))),
FreeVars)
rnOverLit HsOverLit t
origLit
= do { opt_NumDecimals <- Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.NumDecimals
; let { lit@(OverLit {ol_val=val})
| opt_NumDecimals = origLit {ol_val = generalizeOverLitVal (ol_val origLit)}
| otherwise = origLit
}
; let std_name = OverLitVal -> Name
hsOverLitName OverLitVal
val
; (from_thing_name, fvs1) <- lookupSyntaxName std_name
; loc <- getSrcSpanM
; let rebindable = Name
from_thing_name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
std_name
lit' = HsOverLit t
lit { ol_ext = OverLitRn { ol_rebindable = rebindable
, ol_from_fun = L (noAnnSrcSpan loc) from_thing_name } }
; if isNegativeZeroOverLit lit'
then do { (negate_expr, fvs2) <- lookupSyntaxExpr negateName
; return ((lit' { ol_val = negateOverLitVal val }, Just negate_expr)
, fvs1 `plusFV` fvs2) }
else return ((lit', Nothing), fvs1) }
rnHsTyPat :: HsDocContext
-> HsTyPat GhcPs
-> CpsRn (HsTyPat GhcRn)
rnHsTyPat :: HsDocContext -> HsTyPat GhcPs -> CpsRn (HsTyPat (GhcPass 'Renamed))
rnHsTyPat HsDocContext
ctxt HsTyPat GhcPs
sigType = case HsTyPat GhcPs
sigType of
(HsTP { hstp_body :: forall pass. HsTyPat pass -> LHsType pass
hstp_body = LHsType GhcPs
hs_ty }) -> do
(hs_ty', tpb) <- TPRnM (GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
-> HsDocContext
-> CpsRn
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)),
HsTyPatRnBuilder)
forall a. TPRnM a -> HsDocContext -> CpsRn (a, HsTyPatRnBuilder)
runTPRnM (LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
hs_ty) HsDocContext
ctxt
pure HsTP
{ hstp_body = hs_ty'
, hstp_ext = buildHsTyPatRn tpb
}
newtype TPRnM a =
MkTPRnM (ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a)
deriving newtype ((forall a b. (a -> b) -> TPRnM a -> TPRnM b)
-> (forall a b. a -> TPRnM b -> TPRnM a) -> Functor TPRnM
forall a b. a -> TPRnM b -> TPRnM a
forall a b. (a -> b) -> TPRnM a -> TPRnM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TPRnM a -> TPRnM b
fmap :: forall a b. (a -> b) -> TPRnM a -> TPRnM b
$c<$ :: forall a b. a -> TPRnM b -> TPRnM a
<$ :: forall a b. a -> TPRnM b -> TPRnM a
Functor, Functor TPRnM
Functor TPRnM =>
(forall a. a -> TPRnM a)
-> (forall a b. TPRnM (a -> b) -> TPRnM a -> TPRnM b)
-> (forall a b c. (a -> b -> c) -> TPRnM a -> TPRnM b -> TPRnM c)
-> (forall a b. TPRnM a -> TPRnM b -> TPRnM b)
-> (forall a b. TPRnM a -> TPRnM b -> TPRnM a)
-> Applicative TPRnM
forall a. a -> TPRnM a
forall a b. TPRnM a -> TPRnM b -> TPRnM a
forall a b. TPRnM a -> TPRnM b -> TPRnM b
forall a b. TPRnM (a -> b) -> TPRnM a -> TPRnM b
forall a b c. (a -> b -> c) -> TPRnM a -> TPRnM b -> TPRnM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> TPRnM a
pure :: forall a. a -> TPRnM a
$c<*> :: forall a b. TPRnM (a -> b) -> TPRnM a -> TPRnM b
<*> :: forall a b. TPRnM (a -> b) -> TPRnM a -> TPRnM b
$cliftA2 :: forall a b c. (a -> b -> c) -> TPRnM a -> TPRnM b -> TPRnM c
liftA2 :: forall a b c. (a -> b -> c) -> TPRnM a -> TPRnM b -> TPRnM c
$c*> :: forall a b. TPRnM a -> TPRnM b -> TPRnM b
*> :: forall a b. TPRnM a -> TPRnM b -> TPRnM b
$c<* :: forall a b. TPRnM a -> TPRnM b -> TPRnM a
<* :: forall a b. TPRnM a -> TPRnM b -> TPRnM a
Applicative, Applicative TPRnM
Applicative TPRnM =>
(forall a b. TPRnM a -> (a -> TPRnM b) -> TPRnM b)
-> (forall a b. TPRnM a -> TPRnM b -> TPRnM b)
-> (forall a. a -> TPRnM a)
-> Monad TPRnM
forall a. a -> TPRnM a
forall a b. TPRnM a -> TPRnM b -> TPRnM b
forall a b. TPRnM a -> (a -> TPRnM b) -> TPRnM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. TPRnM a -> (a -> TPRnM b) -> TPRnM b
>>= :: forall a b. TPRnM a -> (a -> TPRnM b) -> TPRnM b
$c>> :: forall a b. TPRnM a -> TPRnM b -> TPRnM b
>> :: forall a b. TPRnM a -> TPRnM b -> TPRnM b
$creturn :: forall a. a -> TPRnM a
return :: forall a. a -> TPRnM a
Monad)
runTPRnM :: TPRnM a -> HsDocContext -> CpsRn (a, HsTyPatRnBuilder)
runTPRnM :: forall a. TPRnM a -> HsDocContext -> CpsRn (a, HsTyPatRnBuilder)
runTPRnM (MkTPRnM ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
thing_inside) HsDocContext
doc_ctxt = WriterT HsTyPatRnBuilder CpsRn a -> CpsRn (a, HsTyPatRnBuilder)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT HsTyPatRnBuilder CpsRn a -> CpsRn (a, HsTyPatRnBuilder))
-> WriterT HsTyPatRnBuilder CpsRn a -> CpsRn (a, HsTyPatRnBuilder)
forall a b. (a -> b) -> a -> b
$ ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> (HsDocContext, OccSet) -> WriterT HsTyPatRnBuilder CpsRn a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
thing_inside (HsDocContext
doc_ctxt, OccSet
emptyOccSet)
askLocals :: TPRnM OccSet
askLocals :: TPRnM OccSet
askLocals = ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) OccSet
-> TPRnM OccSet
forall a.
ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a
MkTPRnM (((HsDocContext, OccSet) -> OccSet)
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) OccSet
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (HsDocContext, OccSet) -> OccSet
forall a b. (a, b) -> b
snd)
askDocContext :: TPRnM HsDocContext
askDocContext :: TPRnM HsDocContext
askDocContext = ReaderT
(HsDocContext, OccSet)
(WriterT HsTyPatRnBuilder CpsRn)
HsDocContext
-> TPRnM HsDocContext
forall a.
ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a
MkTPRnM (((HsDocContext, OccSet) -> HsDocContext)
-> ReaderT
(HsDocContext, OccSet)
(WriterT HsTyPatRnBuilder CpsRn)
HsDocContext
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (HsDocContext, OccSet) -> HsDocContext
forall a b. (a, b) -> a
fst)
tellTPB :: HsTyPatRnBuilder -> TPRnM ()
tellTPB :: HsTyPatRnBuilder -> TPRnM ()
tellTPB = ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) ()
-> TPRnM ()
forall a.
ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a
MkTPRnM (ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) ()
-> TPRnM ())
-> (HsTyPatRnBuilder
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) ())
-> HsTyPatRnBuilder
-> TPRnM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT HsTyPatRnBuilder CpsRn ()
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HsDocContext, OccSet) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT HsTyPatRnBuilder CpsRn ()
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) ())
-> (HsTyPatRnBuilder -> WriterT HsTyPatRnBuilder CpsRn ())
-> HsTyPatRnBuilder
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTyPatRnBuilder -> WriterT HsTyPatRnBuilder CpsRn ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell
liftRnFV :: RnM (a, FreeVars) -> TPRnM a
liftRnFV :: forall a. RnM (a, FreeVars) -> TPRnM a
liftRnFV = CpsRn a -> TPRnM a
forall a. CpsRn a -> TPRnM a
liftTPRnCps (CpsRn a -> TPRnM a)
-> (RnM (a, FreeVars) -> CpsRn a) -> RnM (a, FreeVars) -> TPRnM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RnM (a, FreeVars) -> CpsRn a
forall a. RnM (a, FreeVars) -> CpsRn a
liftCpsFV
liftRn :: RnM a -> TPRnM a
liftRn :: forall a. RnM a -> TPRnM a
liftRn = CpsRn a -> TPRnM a
forall a. CpsRn a -> TPRnM a
liftTPRnCps (CpsRn a -> TPRnM a) -> (RnM a -> CpsRn a) -> RnM a -> TPRnM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RnM a -> CpsRn a
forall a. RnM a -> CpsRn a
liftCps
liftRnWithCont :: (forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)) -> TPRnM b
liftRnWithCont :: forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> TPRnM b
liftRnWithCont forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
cont = CpsRn b -> TPRnM b
forall a. CpsRn a -> TPRnM a
liftTPRnCps ((forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
liftCpsWithCont (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
cont)
liftTPRnCps :: CpsRn a -> TPRnM a
liftTPRnCps :: forall a. CpsRn a -> TPRnM a
liftTPRnCps = ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a
forall a.
ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a
MkTPRnM (ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a)
-> (CpsRn a
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a)
-> CpsRn a
-> TPRnM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT HsTyPatRnBuilder CpsRn a
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HsDocContext, OccSet) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT HsTyPatRnBuilder CpsRn a
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a)
-> (CpsRn a -> WriterT HsTyPatRnBuilder CpsRn a)
-> CpsRn a
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CpsRn a -> WriterT HsTyPatRnBuilder CpsRn a
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT HsTyPatRnBuilder m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
liftTPRnRaw ::
( forall r .
HsDocContext ->
OccSet ->
((a, HsTyPatRnBuilder) -> RnM (r, FreeVars)) ->
RnM (r, FreeVars)
) -> TPRnM a
liftTPRnRaw :: forall a.
(forall r.
HsDocContext
-> OccSet
-> ((a, HsTyPatRnBuilder) -> RnM (r, FreeVars))
-> RnM (r, FreeVars))
-> TPRnM a
liftTPRnRaw forall r.
HsDocContext
-> OccSet
-> ((a, HsTyPatRnBuilder) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
cont = ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a
forall a.
ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a
MkTPRnM (ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a)
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> TPRnM a
forall a b. (a -> b) -> a -> b
$ ((HsDocContext, OccSet) -> WriterT HsTyPatRnBuilder CpsRn a)
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((HsDocContext, OccSet) -> WriterT HsTyPatRnBuilder CpsRn a)
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a)
-> ((HsDocContext, OccSet) -> WriterT HsTyPatRnBuilder CpsRn a)
-> ReaderT
(HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
forall a b. (a -> b) -> a -> b
$ \(HsDocContext
doc_ctxt, OccSet
locals) -> CpsRn (a, HsTyPatRnBuilder) -> WriterT HsTyPatRnBuilder CpsRn a
forall (m :: * -> *) w a.
(Functor m, Monoid w) =>
m (a, w) -> WriterT w m a
writerT (CpsRn (a, HsTyPatRnBuilder) -> WriterT HsTyPatRnBuilder CpsRn a)
-> CpsRn (a, HsTyPatRnBuilder) -> WriterT HsTyPatRnBuilder CpsRn a
forall a b. (a -> b) -> a -> b
$ (forall r.
((a, HsTyPatRnBuilder) -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn (a, HsTyPatRnBuilder)
forall b.
(forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn b
liftCpsWithCont (HsDocContext
-> OccSet
-> ((a, HsTyPatRnBuilder) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
forall r.
HsDocContext
-> OccSet
-> ((a, HsTyPatRnBuilder) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
cont HsDocContext
doc_ctxt OccSet
locals)
unTPRnRaw ::
TPRnM a ->
HsDocContext ->
OccSet ->
((a, HsTyPatRnBuilder) -> RnM (r, FreeVars)) ->
RnM (r, FreeVars)
unTPRnRaw :: forall a r.
TPRnM a
-> HsDocContext
-> OccSet
-> ((a, HsTyPatRnBuilder) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
unTPRnRaw (MkTPRnM ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
m) HsDocContext
doc_ctxt OccSet
locals = CpsRn (a, HsTyPatRnBuilder)
-> forall r.
((a, HsTyPatRnBuilder) -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
forall b.
CpsRn b -> forall r. (b -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
unCpsRn (CpsRn (a, HsTyPatRnBuilder)
-> forall r.
((a, HsTyPatRnBuilder) -> RnM (r, FreeVars)) -> RnM (r, FreeVars))
-> CpsRn (a, HsTyPatRnBuilder)
-> forall r.
((a, HsTyPatRnBuilder) -> RnM (r, FreeVars)) -> RnM (r, FreeVars)
forall a b. (a -> b) -> a -> b
$ WriterT HsTyPatRnBuilder CpsRn a -> CpsRn (a, HsTyPatRnBuilder)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT HsTyPatRnBuilder CpsRn a -> CpsRn (a, HsTyPatRnBuilder))
-> WriterT HsTyPatRnBuilder CpsRn a -> CpsRn (a, HsTyPatRnBuilder)
forall a b. (a -> b) -> a -> b
$ ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
-> (HsDocContext, OccSet) -> WriterT HsTyPatRnBuilder CpsRn a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a
m (HsDocContext
doc_ctxt, OccSet
locals)
wrapSrcSpanTPRnM :: (a -> TPRnM b) -> LocatedAn ann a -> TPRnM (LocatedAn ann b)
wrapSrcSpanTPRnM :: forall a b ann.
(a -> TPRnM b) -> LocatedAn ann a -> TPRnM (LocatedAn ann b)
wrapSrcSpanTPRnM a -> TPRnM b
fn (L EpAnn ann
loc a
a) = do
a' <- a -> TPRnM b
fn a
a
pure (L loc a')
lookupTypeOccTPRnM :: RdrName -> TPRnM Name
lookupTypeOccTPRnM :: RdrName -> TPRnM Name
lookupTypeOccTPRnM RdrName
rdr_name = RnM (Name, FreeVars) -> TPRnM Name
forall a. RnM (a, FreeVars) -> TPRnM a
liftRnFV (RnM (Name, FreeVars) -> TPRnM Name)
-> RnM (Name, FreeVars) -> TPRnM Name
forall a b. (a -> b) -> a -> b
$ do
name <- RdrName -> RnM Name
lookupTypeOccRn RdrName
rdr_name
pure (name, unitFV name)
rn_lty_pat :: LHsType GhcPs -> TPRnM (LHsType GhcRn)
rn_lty_pat :: LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat (L EpAnn AnnListItem
l HsType GhcPs
hs_ty) = do
hs_ty' <- HsType GhcPs -> TPRnM (HsType (GhcPass 'Renamed))
rn_ty_pat HsType GhcPs
hs_ty
pure (L l hs_ty')
rn_ty_pat_var :: LocatedN RdrName -> TPRnM (LocatedN Name)
rn_ty_pat_var :: LocatedN RdrName -> TPRnM (LocatedN Name)
rn_ty_pat_var lrdr :: LocatedN RdrName
lrdr@(L SrcSpanAnnN
l RdrName
rdr) = do
locals <- TPRnM OccSet
askLocals
if isRdrTyVar rdr
&& not (elemOccSet (occName rdr) locals)
then do
name <- liftTPRnCps $ newPatName (LamMk True) lrdr
tellTPB (tpBuilderExplicitTV name)
pure (L l name)
else do
name <- lookupTypeOccTPRnM rdr
pure (L l name)
rn_ty_pat :: HsType GhcPs -> TPRnM (HsType GhcRn)
rn_ty_pat :: HsType GhcPs -> TPRnM (HsType (GhcPass 'Renamed))
rn_ty_pat tv :: HsType GhcPs
tv@(HsTyVar XTyVar GhcPs
an PromotionFlag
prom XRec GhcPs (IdP GhcPs)
lrdr) = do
lname@(L _ name) <- LocatedN RdrName -> TPRnM (LocatedN Name)
rn_ty_pat_var XRec GhcPs (IdP GhcPs)
LocatedN RdrName
lrdr
when (isDataConName name && not (isKindName name)) $
check_data_kinds tv
pure (HsTyVar an prom lname)
rn_ty_pat (HsForAllTy XForAllTy GhcPs
an HsForAllTelescope GhcPs
tele LHsType GhcPs
body) = (forall r.
HsDocContext
-> OccSet
-> ((HsType (GhcPass 'Renamed), HsTyPatRnBuilder)
-> RnM (r, FreeVars))
-> RnM (r, FreeVars))
-> TPRnM (HsType (GhcPass 'Renamed))
forall a.
(forall r.
HsDocContext
-> OccSet
-> ((a, HsTyPatRnBuilder) -> RnM (r, FreeVars))
-> RnM (r, FreeVars))
-> TPRnM a
liftTPRnRaw ((forall r.
HsDocContext
-> OccSet
-> ((HsType (GhcPass 'Renamed), HsTyPatRnBuilder)
-> RnM (r, FreeVars))
-> RnM (r, FreeVars))
-> TPRnM (HsType (GhcPass 'Renamed)))
-> (forall r.
HsDocContext
-> OccSet
-> ((HsType (GhcPass 'Renamed), HsTyPatRnBuilder)
-> RnM (r, FreeVars))
-> RnM (r, FreeVars))
-> TPRnM (HsType (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ \HsDocContext
ctxt OccSet
locals (HsType (GhcPass 'Renamed), HsTyPatRnBuilder) -> RnM (r, FreeVars)
thing_inside ->
HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope (GhcPass 'Renamed) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
forall a.
HsDocContext
-> HsForAllTelescope GhcPs
-> (HsForAllTelescope (GhcPass 'Renamed) -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
bindHsForAllTelescope HsDocContext
ctxt HsForAllTelescope GhcPs
tele ((HsForAllTelescope (GhcPass 'Renamed) -> RnM (r, FreeVars))
-> RnM (r, FreeVars))
-> (HsForAllTelescope (GhcPass 'Renamed) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
forall a b. (a -> b) -> a -> b
$ \HsForAllTelescope (GhcPass 'Renamed)
tele' -> do
let
tele_names :: [IdP (GhcPass 'Renamed)]
tele_names = HsForAllTelescope (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (p :: Pass).
HsForAllTelescope (GhcPass p) -> [IdP (GhcPass p)]
hsForAllTelescopeNames HsForAllTelescope (GhcPass 'Renamed)
tele'
locals' :: OccSet
locals' = OccSet
locals OccSet -> [OccName] -> OccSet
`extendOccSetList` (Name -> OccName) -> [Name] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> OccName
forall name. HasOccName name => name -> OccName
occName [IdP (GhcPass 'Renamed)]
[Name]
tele_names
TPRnM (GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
-> HsDocContext
-> OccSet
-> ((GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)),
HsTyPatRnBuilder)
-> RnM (r, FreeVars))
-> RnM (r, FreeVars)
forall a r.
TPRnM a
-> HsDocContext
-> OccSet
-> ((a, HsTyPatRnBuilder) -> RnM (r, FreeVars))
-> RnM (r, FreeVars)
unTPRnRaw (LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
body) HsDocContext
ctxt OccSet
locals' (((GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)),
HsTyPatRnBuilder)
-> RnM (r, FreeVars))
-> RnM (r, FreeVars))
-> ((GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)),
HsTyPatRnBuilder)
-> RnM (r, FreeVars))
-> RnM (r, FreeVars)
forall a b. (a -> b) -> a -> b
$ \(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))
body', HsTyPatRnBuilder
tpb) ->
[Name] -> RnM (r, FreeVars) -> RnM (r, FreeVars)
forall a. [Name] -> RnM a -> RnM a
delLocalNames [IdP (GhcPass 'Renamed)]
[Name]
tele_names (RnM (r, FreeVars) -> RnM (r, FreeVars))
-> RnM (r, FreeVars) -> RnM (r, FreeVars)
forall a b. (a -> b) -> a -> b
$
(HsType (GhcPass 'Renamed), HsTyPatRnBuilder) -> RnM (r, FreeVars)
thing_inside ((XForAllTy (GhcPass 'Renamed)
-> HsForAllTelescope (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall pass.
XForAllTy pass
-> HsForAllTelescope pass -> LHsType pass -> HsType pass
HsForAllTy XForAllTy GhcPs
XForAllTy (GhcPass 'Renamed)
an HsForAllTelescope (GhcPass 'Renamed)
tele' LHsType (GhcPass 'Renamed)
GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))
body'), HsTyPatRnBuilder
tpb)
rn_ty_pat (HsQualTy XQualTy GhcPs
an LHsContext GhcPs
lctx LHsType GhcPs
body) = do
lctx' <- ([GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
-> TPRnM
[GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))])
-> LocatedAn
AnnContext [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
-> TPRnM
(LocatedAn
AnnContext
[GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))])
forall a b ann.
(a -> TPRnM b) -> LocatedAn ann a -> TPRnM (LocatedAn ann b)
wrapSrcSpanTPRnM ((GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))))
-> [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
-> TPRnM
[GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
rn_lty_pat) LHsContext GhcPs
LocatedAn
AnnContext [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
lctx
body' <- rn_lty_pat body
pure (HsQualTy an lctx' body')
rn_ty_pat (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
fun_ty LHsType GhcPs
arg_ty) = do
fun_ty' <- LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
fun_ty
arg_ty' <- rn_lty_pat arg_ty
pure (HsAppTy noExtField fun_ty' arg_ty')
rn_ty_pat (HsAppKindTy XAppKindTy GhcPs
_ LHsType GhcPs
ty LHsType GhcPs
ki) = do
kind_app <- RnM Bool -> TPRnM Bool
forall a. RnM a -> TPRnM a
liftRn (RnM Bool -> TPRnM Bool) -> RnM Bool -> TPRnM Bool
forall a b. (a -> b) -> a -> b
$ Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeApplications
unless kind_app (liftRn $ addErr (typeAppErr KindLevel ki))
ty' <- rn_lty_pat ty
ki' <- rn_lty_pat ki
pure (HsAppKindTy noExtField ty' ki')
rn_ty_pat (HsFunTy XFunTy GhcPs
an HsArrow GhcPs
mult LHsType GhcPs
lhs LHsType GhcPs
rhs) = do
lhs' <- LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
lhs
mult' <- rn_ty_pat_arrow mult
rhs' <- rn_lty_pat rhs
pure (HsFunTy an mult' lhs' rhs')
rn_ty_pat (HsListTy XListTy GhcPs
an LHsType GhcPs
ty) = do
ty' <- LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
ty
pure (HsListTy an ty')
rn_ty_pat (HsTupleTy XTupleTy GhcPs
an HsTupleSort
con [LHsType GhcPs]
tys) = do
tys' <- (GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))))
-> [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
-> TPRnM
[GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
rn_lty_pat [LHsType GhcPs]
[GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
tys
pure (HsTupleTy an con tys')
rn_ty_pat (HsSumTy XSumTy GhcPs
an [LHsType GhcPs]
tys) = do
tys' <- (GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))))
-> [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
-> TPRnM
[GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
rn_lty_pat [LHsType GhcPs]
[GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
tys
pure (HsSumTy an tys')
rn_ty_pat (HsOpTy XOpTy GhcPs
_ PromotionFlag
prom LHsType GhcPs
ty1 XRec GhcPs (IdP GhcPs)
l_op LHsType GhcPs
ty2) = do
ty1' <- LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
ty1
l_op' <- rn_ty_pat_var l_op
ty2' <- rn_lty_pat ty2
fix <- liftRn $ lookupTyFixityRn l_op'
let op_name = LocatedN Name -> Name
forall l e. GenLocated l e -> e
unLoc LocatedN Name
l_op'
when (isDataConName op_name && not (isPromoted prom)) $
liftRn $ addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor Infix op_name)
liftRn $ mkHsOpTyRn prom l_op' fix ty1' ty2'
rn_ty_pat (HsParTy XParTy GhcPs
an LHsType GhcPs
ty) = do
ty' <- LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
ty
pure (HsParTy an ty')
rn_ty_pat (HsIParamTy XIParamTy GhcPs
an XRec GhcPs HsIPName
n LHsType GhcPs
ty) = do
ty' <- LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
ty
pure (HsIParamTy an n ty')
rn_ty_pat (HsStarTy XStarTy GhcPs
an Bool
unicode) =
HsType (GhcPass 'Renamed) -> TPRnM (HsType (GhcPass 'Renamed))
forall a. a -> TPRnM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XStarTy (GhcPass 'Renamed) -> Bool -> HsType (GhcPass 'Renamed)
forall pass. XStarTy pass -> Bool -> HsType pass
HsStarTy XStarTy GhcPs
XStarTy (GhcPass 'Renamed)
an Bool
unicode)
rn_ty_pat (HsDocTy XDocTy GhcPs
an LHsType GhcPs
ty LHsDoc GhcPs
haddock_doc) = do
ty' <- LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
ty
haddock_doc' <- liftRn $ rnLHsDoc haddock_doc
pure (HsDocTy an ty' haddock_doc')
rn_ty_pat ty :: HsType GhcPs
ty@(HsExplicitListTy XExplicitListTy GhcPs
_ PromotionFlag
prom [LHsType GhcPs]
tys) = do
HsType GhcPs -> TPRnM ()
check_data_kinds HsType GhcPs
ty
Bool -> TPRnM () -> TPRnM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PromotionFlag -> Bool
isPromoted PromotionFlag
prom) (TPRnM () -> TPRnM ()) -> TPRnM () -> TPRnM ()
forall a b. (a -> b) -> a -> b
$
IOEnv (Env TcGblEnv TcLclEnv) () -> TPRnM ()
forall a. RnM a -> TPRnM a
liftRn (IOEnv (Env TcGblEnv TcLclEnv) () -> TPRnM ())
-> IOEnv (Env TcGblEnv TcLclEnv) () -> TPRnM ()
forall a b. (a -> b) -> a -> b
$ TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic (UntickedPromotedThing -> TcRnMessage
TcRnUntickedPromotedThing (UntickedPromotedThing -> TcRnMessage)
-> UntickedPromotedThing -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ UntickedPromotedThing
UntickedExplicitList)
tys' <- (GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))))
-> [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
-> TPRnM
[GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
rn_lty_pat [LHsType GhcPs]
[GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
tys
pure (HsExplicitListTy noExtField prom tys')
rn_ty_pat ty :: HsType GhcPs
ty@(HsExplicitTupleTy XExplicitTupleTy GhcPs
_ [LHsType GhcPs]
tys) = do
HsType GhcPs -> TPRnM ()
check_data_kinds HsType GhcPs
ty
tys' <- (GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))))
-> [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
-> TPRnM
[GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
GenLocated (EpAnn AnnListItem) (HsType GhcPs)
-> TPRnM
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
rn_lty_pat [LHsType GhcPs]
[GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
tys
pure (HsExplicitTupleTy noExtField tys')
rn_ty_pat tyLit :: HsType GhcPs
tyLit@(HsTyLit XTyLit GhcPs
src HsTyLit GhcPs
t) = do
HsType GhcPs -> TPRnM ()
check_data_kinds HsType GhcPs
tyLit
t' <- RnM (HsTyLit (GhcPass 'Renamed))
-> TPRnM (HsTyLit (GhcPass 'Renamed))
forall a. RnM a -> TPRnM a
liftRn (RnM (HsTyLit (GhcPass 'Renamed))
-> TPRnM (HsTyLit (GhcPass 'Renamed)))
-> RnM (HsTyLit (GhcPass 'Renamed))
-> TPRnM (HsTyLit (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ HsTyLit GhcPs -> RnM (HsTyLit (GhcPass 'Renamed))
rnHsTyLit HsTyLit GhcPs
t
pure (HsTyLit src t')
rn_ty_pat (HsWildCardTy XWildCardTy GhcPs
_) =
HsType (GhcPass 'Renamed) -> TPRnM (HsType (GhcPass 'Renamed))
forall a. a -> TPRnM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XWildCardTy (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
forall pass. XWildCardTy pass -> HsType pass
HsWildCardTy XWildCardTy (GhcPass 'Renamed)
NoExtField
noExtField)
rn_ty_pat (HsKindSig XKindSig GhcPs
an LHsType GhcPs
ty LHsType GhcPs
ki) = do
ctxt <- TPRnM HsDocContext
askDocContext
kind_sigs_ok <- liftRn $ xoptM LangExt.KindSignatures
unless kind_sigs_ok (liftRn $ badKindSigErr ctxt ki)
~(HsPS hsps ki') <- liftRnWithCont $
rnHsPatSigKind AlwaysBind ctxt (HsPS noAnn ki)
ty' <- rn_lty_pat ty
tellTPB (tpBuilderPatSig hsps)
pure (HsKindSig an ty' ki')
rn_ty_pat (HsSpliceTy XSpliceTy GhcPs
_ HsUntypedSplice GhcPs
splice) = do
res <- RnM
((HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LHsType GhcPs)),
FreeVars)
-> TPRnM
(HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LHsType GhcPs))
forall a. RnM (a, FreeVars) -> TPRnM a
liftRnFV (RnM
((HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LHsType GhcPs)),
FreeVars)
-> TPRnM
(HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LHsType GhcPs)))
-> RnM
((HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LHsType GhcPs)),
FreeVars)
-> TPRnM
(HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LHsType GhcPs))
forall a b. (a -> b) -> a -> b
$ HsUntypedSplice GhcPs
-> RnM
((HsUntypedSplice (GhcPass 'Renamed),
HsUntypedSpliceResult (LHsType GhcPs)),
FreeVars)
rnSpliceTyPat HsUntypedSplice GhcPs
splice
case res of
(HsUntypedSplice (GhcPass 'Renamed)
rn_splice, HsUntypedSpliceTop ThModFinalizers
mfs LHsType GhcPs
pat) -> do
pat' <- LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
pat
pure (HsSpliceTy (HsUntypedSpliceTop mfs (mb_paren pat')) rn_splice)
(HsUntypedSplice (GhcPass 'Renamed)
rn_splice, HsUntypedSpliceNested Name
splice_name) ->
HsType (GhcPass 'Renamed) -> TPRnM (HsType (GhcPass 'Renamed))
forall a. a -> TPRnM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XSpliceTy (GhcPass 'Renamed)
-> HsUntypedSplice (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
forall pass. XSpliceTy pass -> HsUntypedSplice pass -> HsType pass
HsSpliceTy (Name
-> HsUntypedSpliceResult
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
forall thing. Name -> HsUntypedSpliceResult thing
HsUntypedSpliceNested Name
splice_name) HsUntypedSplice (GhcPass 'Renamed)
rn_splice)
where
mb_paren :: LHsType GhcRn -> LHsType GhcRn
mb_paren :: LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
mb_paren lhs_ty :: LHsType (GhcPass 'Renamed)
lhs_ty@(L EpAnn AnnListItem
loc HsType (GhcPass 'Renamed)
hs_ty)
| PprPrec -> HsType (GhcPass 'Renamed) -> Bool
forall (p :: Pass). PprPrec -> HsType (GhcPass p) -> Bool
hsTypeNeedsParens PprPrec
maxPrec HsType (GhcPass 'Renamed)
hs_ty = EpAnn AnnListItem
-> HsType (GhcPass 'Renamed)
-> GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
L EpAnn AnnListItem
loc (XParTy (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy (EpToken "(", EpToken ")")
XParTy (GhcPass 'Renamed)
forall a. NoAnn a => a
noAnn LHsType (GhcPass 'Renamed)
lhs_ty)
| Bool
otherwise = LHsType (GhcPass 'Renamed)
lhs_ty
rn_ty_pat (HsBangTy XBangTy GhcPs
an HsBang
bang_src LHsType GhcPs
lty) = do
ctxt <- TPRnM HsDocContext
askDocContext
lty'@(L _ ty') <- rn_lty_pat lty
liftRn $ addErr $
TcRnWithHsDocContext ctxt $
TcRnUnexpectedAnnotation ty' bang_src
pure (HsBangTy an bang_src lty')
rn_ty_pat ty :: HsType GhcPs
ty@HsRecTy{} = do
ctxt <- TPRnM HsDocContext
askDocContext
liftRn $ addErr $
TcRnWithHsDocContext ctxt $
TcRnIllegalRecordSyntax (Left ty)
pure (HsWildCardTy noExtField)
rn_ty_pat ty :: HsType GhcPs
ty@(XHsType{}) = do
ctxt <- TPRnM HsDocContext
askDocContext
liftRnFV $ rnHsType ctxt ty
rn_ty_pat_arrow :: HsArrow GhcPs -> TPRnM (HsArrow GhcRn)
rn_ty_pat_arrow :: HsArrow GhcPs -> TPRnM (HsArrow (GhcPass 'Renamed))
rn_ty_pat_arrow (HsUnrestrictedArrow XUnrestrictedArrow (LHsType GhcPs) GhcPs
_) = HsArrowOf
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
-> TPRnM
(HsArrowOf
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed))
forall a. a -> TPRnM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XUnrestrictedArrow
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
-> HsArrowOf
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
forall mult pass.
XUnrestrictedArrow mult pass -> HsArrowOf mult pass
HsUnrestrictedArrow NoExtField
XUnrestrictedArrow
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
noExtField)
rn_ty_pat_arrow (HsLinearArrow XLinearArrow (LHsType GhcPs) GhcPs
_) = HsArrowOf
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
-> TPRnM
(HsArrowOf
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed))
forall a. a -> TPRnM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XLinearArrow
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
-> HsArrowOf
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
forall mult pass. XLinearArrow mult pass -> HsArrowOf mult pass
HsLinearArrow NoExtField
XLinearArrow
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
noExtField)
rn_ty_pat_arrow (HsExplicitMult XExplicitMult (LHsType GhcPs) GhcPs
_ LHsType GhcPs
p)
= LHsType GhcPs -> TPRnM (LHsType (GhcPass 'Renamed))
rn_lty_pat LHsType GhcPs
p TPRnM (GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
-> (GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))
-> HsArrowOf
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed))
-> TPRnM
(HsArrowOf
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))
mult -> XExplicitMult
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
-> GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))
-> HsArrowOf
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
forall mult pass.
XExplicitMult mult pass -> mult -> HsArrowOf mult pass
HsExplicitMult NoExtField
XExplicitMult
(GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed)))
(GhcPass 'Renamed)
noExtField GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))
mult)
check_data_kinds :: HsType GhcPs -> TPRnM ()
check_data_kinds :: HsType GhcPs -> TPRnM ()
check_data_kinds HsType GhcPs
thing = IOEnv (Env TcGblEnv TcLclEnv) () -> TPRnM ()
forall a. RnM a -> TPRnM a
liftRn (IOEnv (Env TcGblEnv TcLclEnv) () -> TPRnM ())
-> IOEnv (Env TcGblEnv TcLclEnv) () -> TPRnM ()
forall a b. (a -> b) -> a -> b
$ do
data_kinds <- Extension -> RnM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
unless data_kinds $
addErr $ TcRnDataKindsError TypeLevel $ Left thing