{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.HsToCore.Quote( dsBracket ) where
import GHC.Prelude
import GHC.Platform
import GHC.Driver.Session
import GHC.HsToCore.Errors.Types
import {-# SOURCE #-} GHC.HsToCore.Expr ( dsExpr )
import GHC.HsToCore.Match.Literal
import GHC.HsToCore.Monad
import GHC.HsToCore.Binds
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH
import GHC.Hs
import GHC.Tc.Utils.TcType
import GHC.Tc.Types.Evidence
import GHC.Core.Class
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Core
import GHC.Core.Type( pattern ManyTy, mkFunTy )
import GHC.Core.Make
import GHC.Core.Utils
import GHC.Builtin.Names
import GHC.Builtin.Names.TH
import GHC.Builtin.Types
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Misc
import GHC.Utils.Monad
import GHC.Data.Bag
import GHC.Data.FastString
import GHC.Data.Maybe
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Unique
import GHC.Types.Basic
import GHC.Types.ForeignCall
import GHC.Types.Var
import GHC.Types.Id
import GHC.Types.SourceText
import GHC.Types.Fixity
import GHC.Types.TyThing
import GHC.Types.Name hiding( varName, tcName )
import GHC.Types.Name.Env
import GHC.TypeLits
import Data.Kind (Constraint)
import qualified GHC.LanguageExtensions as LangExt
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
import Data.ByteString ( unpack )
import Control.Monad
import Data.List (sort, sortBy)
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Function
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import Data.Foldable ( toList )
import GHC.Types.Name.Reader (RdrName(..))
data MetaWrappers = MetaWrappers {
MetaWrappers -> CoreExpr -> CoreExpr
quoteWrapper :: CoreExpr -> CoreExpr
, MetaWrappers -> CoreExpr -> CoreExpr
monadWrapper :: CoreExpr -> CoreExpr
, MetaWrappers -> Type -> Type
metaTy :: Type -> Type
, MetaWrappers -> (HsWrapper, HsWrapper, Type)
_debugWrappers :: (HsWrapper, HsWrapper, Type)
}
mkMetaWrappers :: QuoteWrapper -> DsM MetaWrappers
mkMetaWrappers :: QuoteWrapper -> DsM MetaWrappers
mkMetaWrappers q :: QuoteWrapper
q@(QuoteWrapper Id
quote_var_raw Type
m_var) = do
let quote_var :: CoreExpr
quote_var = Id -> CoreExpr
forall b. Id -> Expr b
Var Id
quote_var_raw
TyCon
quote_tc <- Name -> DsM TyCon
dsLookupTyCon Name
quoteClassName
TyCon
monad_tc <- Name -> DsM TyCon
dsLookupTyCon Name
monadClassName
let Just Class
cls = TyCon -> Maybe Class
tyConClass_maybe TyCon
quote_tc
Just Class
monad_cls = TyCon -> Maybe Class
tyConClass_maybe TyCon
monad_tc
monad_sel :: Id
monad_sel = Class -> Int -> Id
classSCSelId Class
cls Int
0
tyvars :: [InvisTVBinder]
tyvars = DataCon -> [InvisTVBinder]
dataConUserTyVarBinders (Class -> DataCon
classDataCon Class
cls)
expected_ty :: Type
expected_ty = [InvisTVBinder] -> Type -> Type
mkInvisForAllTys [InvisTVBinder]
tyvars (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
(() :: Constraint) => FunTyFlag -> Type -> Type -> Type -> Type
FunTyFlag -> Type -> Type -> Type -> Type
mkFunTy FunTyFlag
invisArgConstraintLike Type
ManyTy
(Class -> [Type] -> Type
mkClassPred Class
cls ([Id] -> [Type]
mkTyVarTys ([InvisTVBinder] -> [Id]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [InvisTVBinder]
tyvars)))
(Class -> [Type] -> Type
mkClassPred Class
monad_cls ([Id] -> [Type]
mkTyVarTys ([InvisTVBinder] -> [Id]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [InvisTVBinder]
tyvars)))
Bool -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr (Id -> Type
idType Id
monad_sel Type -> Type -> Bool
`eqType` Type
expected_ty) (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
monad_sel SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
expected_ty)
let m_ty :: CoreExpr
m_ty = Type -> CoreExpr
forall b. Type -> Expr b
Type Type
m_var
quoteWrapper :: HsWrapper
quoteWrapper = QuoteWrapper -> HsWrapper
applyQuoteWrapper QuoteWrapper
q
monadWrapper :: HsWrapper
monadWrapper = [EvTerm] -> HsWrapper
mkWpEvApps [CoreExpr -> EvTerm
EvExpr (CoreExpr -> EvTerm) -> CoreExpr -> EvTerm
forall a b. (a -> b) -> a -> b
$ CoreExpr -> [CoreExpr] -> CoreExpr
mkCoreApps (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
monad_sel) [CoreExpr
m_ty, CoreExpr
quote_var]] HsWrapper -> HsWrapper -> HsWrapper
<.>
[Type] -> HsWrapper
mkWpTyApps [Type
m_var]
tyWrapper :: Type -> Type
tyWrapper Type
t = Type -> Type -> Type
mkAppTy Type
m_var Type
t
debug :: (HsWrapper, HsWrapper, Type)
debug = (HsWrapper
quoteWrapper, HsWrapper
monadWrapper, Type
m_var)
CoreExpr -> CoreExpr
q_f <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
dsHsWrapper HsWrapper
quoteWrapper
CoreExpr -> CoreExpr
m_f <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
dsHsWrapper HsWrapper
monadWrapper
MetaWrappers -> DsM MetaWrappers
forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CoreExpr -> CoreExpr)
-> (CoreExpr -> CoreExpr)
-> (Type -> Type)
-> (HsWrapper, HsWrapper, Type)
-> MetaWrappers
MetaWrappers CoreExpr -> CoreExpr
q_f CoreExpr -> CoreExpr
m_f Type -> Type
tyWrapper (HsWrapper, HsWrapper, Type)
debug)
wrapName :: Name -> MetaM Type
wrapName :: Name -> MetaM Type
wrapName Name
n = do
Type
t <- Name -> MetaM Type
lookupType Name
n
Type -> Type
wrap_fn <- (MetaWrappers -> Type -> Type)
-> ReaderT MetaWrappers DsM (Type -> Type)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks MetaWrappers -> Type -> Type
metaTy
Type -> MetaM Type
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Type
wrap_fn Type
t)
type MetaM a = ReaderT MetaWrappers DsM a
getPlatform :: MetaM Platform
getPlatform :: MetaM Platform
getPlatform = DynFlags -> Platform
targetPlatform (DynFlags -> Platform)
-> ReaderT MetaWrappers DsM DynFlags -> MetaM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT MetaWrappers DsM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
dsBracket :: HsBracketTc -> DsM CoreExpr
dsBracket :: HsBracketTc -> DsM CoreExpr
dsBracket (HsBracketTc { hsb_wrap :: HsBracketTc -> Maybe QuoteWrapper
hsb_wrap = Maybe QuoteWrapper
mb_wrap, hsb_splices :: HsBracketTc -> [PendingTcSplice]
hsb_splices = [PendingTcSplice]
splices, hsb_quote :: HsBracketTc -> HsQuote GhcRn
hsb_quote = HsQuote GhcRn
quote })
= case HsQuote GhcRn
quote of
VarBr XVarBr GhcRn
_ Bool
_ LIdP GhcRn
n -> do { MkC CoreExpr
e1 <- Name -> DsM (Core Name)
lookupOccDsM (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
n) ; CoreExpr -> DsM CoreExpr
forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1 }
ExpBr XExpBr GhcRn
_ LHsExpr GhcRn
e -> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded (ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ do { MkC CoreExpr
e1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e ; CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1 }
PatBr XPatBr GhcRn
_ LPat GhcRn
p -> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded (ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ do { MkC CoreExpr
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repTopP LPat GhcRn
p ; CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
p1 }
TypBr XTypBr GhcRn
_ XRec GhcRn (HsType GhcRn)
t -> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded (ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ do { MkC CoreExpr
t1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
t ; CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
t1 }
DecBrG XDecBrG GhcRn
_ HsGroup GhcRn
gp -> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded (ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ do { MkC CoreExpr
ds1 <- HsGroup GhcRn -> MetaM (Core (M [Dec]))
repTopDs HsGroup GhcRn
gp ; CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
ds1 }
DecBrL {} -> String -> DsM CoreExpr
forall a. HasCallStack => String -> a
panic String
"dsUntypedBracket: unexpected DecBrL"
where
Just QuoteWrapper
wrap = Maybe QuoteWrapper
mb_wrap
runOverloaded :: ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded ReaderT MetaWrappers DsM CoreExpr
act = do { MetaWrappers
mw <- QuoteWrapper -> DsM MetaWrappers
mkMetaWrappers QuoteWrapper
wrap
; ReaderT MetaWrappers DsM CoreExpr -> MetaWrappers -> DsM CoreExpr
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr
-> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (DsMetaEnv -> DsM CoreExpr -> DsM CoreExpr
forall a. DsMetaEnv -> DsM a -> DsM a
dsExtendMetaEnv DsMetaEnv
new_bit) ReaderT MetaWrappers DsM CoreExpr
act) MetaWrappers
mw }
new_bit :: DsMetaEnv
new_bit = [(Name, DsMetaVal)] -> DsMetaEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name
n, HsExpr GhcTc -> DsMetaVal
DsSplice (GenLocated SrcSpanAnnA (HsExpr GhcTc) -> HsExpr GhcTc
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
e))
| PendingTcSplice Name
n LHsExpr GhcTc
e <- [PendingTcSplice]
splices]
data M a
repTopP :: LPat GhcRn -> MetaM (Core (M TH.Pat))
repTopP :: LPat GhcRn -> MetaM (Core (M Pat))
repTopP LPat GhcRn
pat = do { [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms (CollectFlag GhcRn -> LPat GhcRn -> [IdP GhcRn]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders LPat GhcRn
pat)
; Core (M Pat)
pat' <- [GenSymBind] -> MetaM (Core (M Pat)) -> MetaM (Core (M Pat))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
pat)
; [GenSymBind] -> Core (M Pat) -> MetaM (Core (M Pat))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Pat)
pat' }
repTopDs :: HsGroup GhcRn -> MetaM (Core (M [TH.Dec]))
repTopDs :: HsGroup GhcRn -> MetaM (Core (M [Dec]))
repTopDs group :: HsGroup GhcRn
group@(HsGroup { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds = HsValBinds GhcRn
valds
, hs_splcds :: forall p. HsGroup p -> [LSpliceDecl p]
hs_splcds = [LSpliceDecl GhcRn]
splcds
, hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds = [TyClGroup GhcRn]
tyclds
, hs_derivds :: forall p. HsGroup p -> [LDerivDecl p]
hs_derivds = [LDerivDecl GhcRn]
derivds
, hs_fixds :: forall p. HsGroup p -> [LFixitySig p]
hs_fixds = [LFixitySig GhcRn]
fixds
, hs_defds :: forall p. HsGroup p -> [LDefaultDecl p]
hs_defds = [LDefaultDecl GhcRn]
defds
, hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
hs_fords = [LForeignDecl GhcRn]
fords
, hs_warnds :: forall p. HsGroup p -> [LWarnDecls p]
hs_warnds = [LWarnDecls GhcRn]
warnds
, hs_annds :: forall p. HsGroup p -> [LAnnDecl p]
hs_annds = [LAnnDecl GhcRn]
annds
, hs_ruleds :: forall p. HsGroup p -> [LRuleDecls p]
hs_ruleds = [LRuleDecls GhcRn]
ruleds
, hs_docs :: forall p. HsGroup p -> [LDocDecl p]
hs_docs = [LDocDecl GhcRn]
docs })
= do { let { bndrs :: [Name]
bndrs = HsValBinds GhcRn -> [Name]
hsScopedTvBinders HsValBinds GhcRn
valds
[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ HsGroup GhcRn -> [Name]
hsGroupBinders HsGroup GhcRn
group
[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FieldOcc GhcRn -> Name) -> [FieldOcc GhcRn] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldOcc GhcRn -> XCFieldOcc GhcRn
FieldOcc GhcRn -> Name
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt (HsValBinds GhcRn -> [FieldOcc GhcRn]
forall (p :: Pass).
IsPass p =>
HsValBinds (GhcPass p) -> [FieldOcc (GhcPass p)]
hsPatSynSelectors HsValBinds GhcRn
valds)
; instds :: [GenLocated SrcSpanAnnA (InstDecl GhcRn)]
instds = [TyClGroup GhcRn]
tyclds [TyClGroup GhcRn]
-> (TyClGroup GhcRn -> [GenLocated SrcSpanAnnA (InstDecl GhcRn)])
-> [GenLocated SrcSpanAnnA (InstDecl GhcRn)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyClGroup GhcRn -> [LInstDecl GhcRn]
TyClGroup GhcRn -> [GenLocated SrcSpanAnnA (InstDecl GhcRn)]
forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds } ;
[GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
bndrs ;
[Core (M Dec)]
decls <- [GenSymBind] -> MetaM [Core (M Dec)] -> MetaM [Core (M Dec)]
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (
do { [(SrcSpan, Core (M Dec))]
val_ds <- HsValBinds GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_val_binds HsValBinds GhcRn
valds
; [Any]
_ <- (GenLocated SrcSpanAnnA (SpliceDecl GhcRn)
-> ReaderT MetaWrappers DsM Any)
-> [GenLocated SrcSpanAnnA (SpliceDecl GhcRn)]
-> ReaderT MetaWrappers DsM [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated SrcSpanAnnA (SpliceDecl GhcRn)
-> ReaderT MetaWrappers DsM Any
forall {a} {e} {a}. GenLocated (SrcSpanAnn' a) e -> MetaM a
no_splice [LSpliceDecl GhcRn]
[GenLocated SrcSpanAnnA (SpliceDecl GhcRn)]
splcds
; [Maybe (SrcSpan, Core (M Dec))]
tycl_ds <- (GenLocated SrcSpanAnnA (TyClDecl GhcRn)
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec))))
-> [GenLocated SrcSpanAnnA (TyClDecl GhcRn)]
-> ReaderT MetaWrappers DsM [Maybe (SrcSpan, Core (M Dec))]
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 LTyClDecl GhcRn
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
GenLocated SrcSpanAnnA (TyClDecl GhcRn)
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
repTyClD ([TyClGroup GhcRn] -> [LTyClDecl GhcRn]
forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls [TyClGroup GhcRn]
tyclds)
; [(SrcSpan, Core (M Dec))]
role_ds <- (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LRoleAnnotDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRoleD ((TyClGroup GhcRn -> [GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)])
-> [TyClGroup GhcRn]
-> [GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyClGroup GhcRn -> [LRoleAnnotDecl GhcRn]
TyClGroup GhcRn -> [GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)]
forall pass. TyClGroup pass -> [LRoleAnnotDecl pass]
group_roles [TyClGroup GhcRn]
tyclds)
; [(SrcSpan, Core (M Dec))]
kisig_ds <- (GenLocated SrcSpanAnnA (StandaloneKindSig GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (StandaloneKindSig GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LStandaloneKindSig GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (StandaloneKindSig GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repKiSigD ((TyClGroup GhcRn
-> [GenLocated SrcSpanAnnA (StandaloneKindSig GhcRn)])
-> [TyClGroup GhcRn]
-> [GenLocated SrcSpanAnnA (StandaloneKindSig GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyClGroup GhcRn -> [LStandaloneKindSig GhcRn]
TyClGroup GhcRn
-> [GenLocated SrcSpanAnnA (StandaloneKindSig GhcRn)]
forall pass. TyClGroup pass -> [LStandaloneKindSig pass]
group_kisigs [TyClGroup GhcRn]
tyclds)
; [(SrcSpan, Core (M Dec))]
inst_ds <- (GenLocated SrcSpanAnnA (InstDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (InstDecl GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LInstDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (InstDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repInstD [GenLocated SrcSpanAnnA (InstDecl GhcRn)]
instds
; [(SrcSpan, Core (M Dec))]
deriv_ds <- (GenLocated SrcSpanAnnA (DerivDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (DerivDecl GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LDerivDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (DerivDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repStandaloneDerivD [LDerivDecl GhcRn]
[GenLocated SrcSpanAnnA (DerivDecl GhcRn)]
derivds
; [[(SrcSpan, Core (M Dec))]]
fix_ds <- (GenLocated SrcSpanAnnA (FixitySig GhcRn)
-> MetaM [(SrcSpan, Core (M Dec))])
-> [GenLocated SrcSpanAnnA (FixitySig GhcRn)]
-> ReaderT MetaWrappers DsM [[(SrcSpan, Core (M Dec))]]
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 LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
GenLocated SrcSpanAnnA (FixitySig GhcRn)
-> MetaM [(SrcSpan, Core (M Dec))]
repLFixD [LFixitySig GhcRn]
[GenLocated SrcSpanAnnA (FixitySig GhcRn)]
fixds
; [(SrcSpan, Core (M Dec))]
def_ds <- (GenLocated SrcSpanAnnA (DefaultDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (DefaultDecl GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LDefaultDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (DefaultDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repDefD [LDefaultDecl GhcRn]
[GenLocated SrcSpanAnnA (DefaultDecl GhcRn)]
defds
; [(SrcSpan, Core (M Dec))]
for_ds <- (GenLocated SrcSpanAnnA (ForeignDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LForeignDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (ForeignDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repForD [LForeignDecl GhcRn]
[GenLocated SrcSpanAnnA (ForeignDecl GhcRn)]
fords
; [Any]
_ <- (GenLocated SrcSpanAnnA (WarnDecl GhcRn)
-> ReaderT MetaWrappers DsM Any)
-> [GenLocated SrcSpanAnnA (WarnDecl GhcRn)]
-> ReaderT MetaWrappers DsM [Any]
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 LWarnDecl GhcRn -> ReaderT MetaWrappers DsM Any
GenLocated SrcSpanAnnA (WarnDecl GhcRn)
-> ReaderT MetaWrappers DsM Any
forall a. LWarnDecl GhcRn -> MetaM a
no_warn ((GenLocated SrcSpanAnnA (WarnDecls GhcRn)
-> [GenLocated SrcSpanAnnA (WarnDecl GhcRn)])
-> [GenLocated SrcSpanAnnA (WarnDecls GhcRn)]
-> [GenLocated SrcSpanAnnA (WarnDecl GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (WarnDecls GhcRn -> [LWarnDecl GhcRn]
WarnDecls GhcRn -> [GenLocated SrcSpanAnnA (WarnDecl GhcRn)]
forall pass. WarnDecls pass -> [LWarnDecl pass]
wd_warnings (WarnDecls GhcRn -> [GenLocated SrcSpanAnnA (WarnDecl GhcRn)])
-> (GenLocated SrcSpanAnnA (WarnDecls GhcRn) -> WarnDecls GhcRn)
-> GenLocated SrcSpanAnnA (WarnDecls GhcRn)
-> [GenLocated SrcSpanAnnA (WarnDecl GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (WarnDecls GhcRn) -> WarnDecls GhcRn
forall l e. GenLocated l e -> e
unLoc)
[LWarnDecls GhcRn]
[GenLocated SrcSpanAnnA (WarnDecls GhcRn)]
warnds)
; [(SrcSpan, Core (M Dec))]
ann_ds <- (GenLocated SrcSpanAnnA (AnnDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (AnnDecl GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LAnnDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (AnnDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repAnnD [LAnnDecl GhcRn]
[GenLocated SrcSpanAnnA (AnnDecl GhcRn)]
annds
; [(SrcSpan, Core (M Dec))]
rule_ds <- (GenLocated SrcSpanAnnA (RuleDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (RuleDecl GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LRuleDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (RuleDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRuleD ((GenLocated SrcSpanAnnA (RuleDecls GhcRn)
-> [GenLocated SrcSpanAnnA (RuleDecl GhcRn)])
-> [GenLocated SrcSpanAnnA (RuleDecls GhcRn)]
-> [GenLocated SrcSpanAnnA (RuleDecl GhcRn)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RuleDecls GhcRn -> [LRuleDecl GhcRn]
RuleDecls GhcRn -> [GenLocated SrcSpanAnnA (RuleDecl GhcRn)]
forall pass. RuleDecls pass -> [LRuleDecl pass]
rds_rules (RuleDecls GhcRn -> [GenLocated SrcSpanAnnA (RuleDecl GhcRn)])
-> (GenLocated SrcSpanAnnA (RuleDecls GhcRn) -> RuleDecls GhcRn)
-> GenLocated SrcSpanAnnA (RuleDecls GhcRn)
-> [GenLocated SrcSpanAnnA (RuleDecl GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (RuleDecls GhcRn) -> RuleDecls GhcRn
forall l e. GenLocated l e -> e
unLoc)
[LRuleDecls GhcRn]
[GenLocated SrcSpanAnnA (RuleDecls GhcRn)]
ruleds)
; [Any]
_ <- (GenLocated SrcSpanAnnA (DocDecl GhcRn)
-> ReaderT MetaWrappers DsM Any)
-> [GenLocated SrcSpanAnnA (DocDecl GhcRn)]
-> ReaderT MetaWrappers DsM [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated SrcSpanAnnA (DocDecl GhcRn)
-> ReaderT MetaWrappers DsM Any
forall {a} {e} {a}. GenLocated (SrcSpanAnn' a) e -> MetaM a
no_doc [LDocDecl GhcRn]
[GenLocated SrcSpanAnnA (DocDecl GhcRn)]
docs
; [Core (M Dec)] -> MetaM [Core (M Dec)]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core (M Dec))] -> [Core (M Dec)])
-> [(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. (a -> b) -> a -> b
$ [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc ([(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))])
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a b. (a -> b) -> a -> b
$
[(SrcSpan, Core (M Dec))]
val_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [Maybe (SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (SrcSpan, Core (M Dec))]
tycl_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
role_ds
[(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
kisig_ds
[(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ ([[(SrcSpan, Core (M Dec))]] -> [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(SrcSpan, Core (M Dec))]]
fix_ds)
[(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
def_ds
[(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
inst_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
rule_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
for_ds
[(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
ann_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
deriv_ds) }) ;
Core [M Dec]
core_list <- Name
-> (Core (M Dec) -> MetaM (Core (M Dec)))
-> [Core (M Dec)]
-> MetaM (Core [M Dec])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
decTyConName Core (M Dec) -> MetaM (Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Core (M Dec)]
decls ;
Type
dec_ty <- Name -> MetaM Type
lookupType Name
decTyConName ;
Core (M [Dec])
q_decs <- Type -> Core [M Dec] -> MetaM (Core (M [Dec]))
forall a. Type -> Core [M a] -> MetaM (Core (M [a]))
repSequenceM Type
dec_ty Core [M Dec]
core_list ;
[GenSymBind] -> Core (M [Dec]) -> MetaM (Core (M [Dec]))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M [Dec])
q_decs
}
where
no_splice :: GenLocated (SrcSpanAnn' a) e -> MetaM a
no_splice (L SrcSpanAnn' a
loc e
_)
= SrcSpan -> ThRejectionReason -> MetaM a
forall a. SrcSpan -> ThRejectionReason -> MetaM a
notHandledL (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc) ThRejectionReason
ThSplicesWithinDeclBrackets
no_warn :: LWarnDecl GhcRn -> MetaM a
no_warn :: forall a. LWarnDecl GhcRn -> MetaM a
no_warn (L SrcSpanAnnA
loc (Warning XWarning GhcRn
_ [LIdP GhcRn]
thing WarningTxt GhcRn
_))
= SrcSpan -> ThRejectionReason -> MetaM a
forall a. SrcSpan -> ThRejectionReason -> MetaM a
notHandledL (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) ([LIdP GhcRn] -> ThRejectionReason
ThWarningAndDeprecationPragmas [LIdP GhcRn]
thing)
no_doc :: GenLocated (SrcSpanAnn' a) e -> MetaM a
no_doc (L SrcSpanAnn' a
loc e
_)
= SrcSpan -> ThRejectionReason -> MetaM a
forall a. SrcSpan -> ThRejectionReason -> MetaM a
notHandledL (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc) ThRejectionReason
ThHaddockDocumentation
hsScopedTvBinders :: HsValBinds GhcRn -> [Name]
hsScopedTvBinders :: HsValBinds GhcRn -> [Name]
hsScopedTvBinders HsValBinds GhcRn
binds
= (GenLocated SrcSpanAnnA (Sig GhcRn) -> [Name])
-> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LSig GhcRn -> [Name]
GenLocated SrcSpanAnnA (Sig GhcRn) -> [Name]
get_scoped_tvs [LSig GhcRn]
[GenLocated SrcSpanAnnA (Sig GhcRn)]
sigs
where
sigs :: [LSig GhcRn]
sigs = case HsValBinds GhcRn
binds of
ValBinds XValBinds GhcRn GhcRn
_ LHsBindsLR GhcRn GhcRn
_ [LSig GhcRn]
sigs -> [LSig GhcRn]
sigs
XValBindsLR (NValBinds [(RecFlag, LHsBindsLR GhcRn GhcRn)]
_ [LSig GhcRn]
sigs) -> [LSig GhcRn]
sigs
get_scoped_tvs :: LSig GhcRn -> [Name]
get_scoped_tvs :: LSig GhcRn -> [Name]
get_scoped_tvs (L SrcSpanAnnA
_ Sig GhcRn
signature)
| TypeSig XTypeSig GhcRn
_ [LIdP GhcRn]
_ LHsSigWcType GhcRn
sig <- Sig GhcRn
signature
= LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> GenLocated SrcSpanAnnA (HsSigType GhcRn)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsSigWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
sig)
| ClassOpSig XClassOpSig GhcRn
_ Bool
_ [LIdP GhcRn]
_ LHsSigType GhcRn
sig <- Sig GhcRn
signature
= LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig LHsSigType GhcRn
sig
| PatSynSig XPatSynSig GhcRn
_ [LIdP GhcRn]
_ LHsSigType GhcRn
sig <- Sig GhcRn
signature
= LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig LHsSigType GhcRn
sig
| Bool
otherwise
= []
get_scoped_tvs_from_sig :: LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig :: LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig (L SrcSpanAnnA
_ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcRn
outer_bndrs})) =
HsOuterSigTyVarBndrs GhcRn -> [Name]
forall flag. HsOuterTyVarBndrs flag GhcRn -> [Name]
hsOuterTyVarNames HsOuterSigTyVarBndrs GhcRn
outer_bndrs
repTyClD :: LTyClDecl GhcRn -> MetaM (Maybe (SrcSpan, Core (M TH.Dec)))
repTyClD :: LTyClDecl GhcRn
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
repTyClD (L SrcSpanAnnA
loc (FamDecl { tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam = FamilyDecl GhcRn
fam })) = ((SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec)))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec))
forall a. a -> Maybe a
Just (ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec))))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall a b. (a -> b) -> a -> b
$
LFamilyDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repFamilyDecl (SrcSpanAnnA
-> FamilyDecl GhcRn -> GenLocated SrcSpanAnnA (FamilyDecl GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc FamilyDecl GhcRn
fam)
repTyClD (L SrcSpanAnnA
loc (SynDecl { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcRn
tc, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
tvs, tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = XRec GhcRn (HsType GhcRn)
rhs }))
= do { Core Name
tc1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
tc
; Core (M Dec)
dec <- FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addQTyVarBinds FreshOrReuse
ReuseBoundNames LHsQTyVars GhcRn
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
Core Name
-> Core [M (TyVarBndr ())]
-> XRec GhcRn (HsType GhcRn)
-> MetaM (Core (M Dec))
repSynDecl Core Name
tc1 Core [M (TyVarBndr ())]
bndrs XRec GhcRn (HsType GhcRn)
rhs
; Maybe (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec))
forall a. a -> Maybe a
Just (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec)) }
repTyClD (L SrcSpanAnnA
loc (DataDecl { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcRn
tc
, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
tvs
, tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn GhcRn
defn }))
= do { Core Name
tc1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
tc
; Core (M Dec)
dec <- FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addQTyVarBinds FreshOrReuse
ReuseBoundNames LHsQTyVars GhcRn
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
Core Name
-> Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> HsDataDefn GhcRn
-> MetaM (Core (M Dec))
repDataDefn Core Name
tc1 (Core [M (TyVarBndr ())]
-> Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
forall a b. a -> Either a b
Left Core [M (TyVarBndr ())]
bndrs) HsDataDefn GhcRn
defn
; Maybe (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec))
forall a. a -> Maybe a
Just (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec)) }
repTyClD (L SrcSpanAnnA
loc (ClassDecl { tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCtxt = Maybe (LHsContext GhcRn)
cxt, tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcRn
cls,
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
tvs, tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdFDs = [LHsFunDep GhcRn]
fds,
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig GhcRn]
sigs, tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths = LHsBindsLR GhcRn GhcRn
meth_binds,
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs = [LFamilyDecl GhcRn]
ats, tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs = [LTyFamDefltDecl GhcRn]
atds }))
= do { Core Name
cls1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
cls
; Core (M Dec)
dec <- FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addQTyVarBinds FreshOrReuse
FreshNamesOnly LHsQTyVars GhcRn
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
do { Core (M Cxt)
cxt1 <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
cxt
; ([GenSymBind]
ss, [Core (M Dec)]
sigs_binds) <- [LSig GhcRn]
-> LHsBindsLR GhcRn GhcRn -> MetaM ([GenSymBind], [Core (M Dec)])
rep_meth_sigs_binds [LSig GhcRn]
sigs LHsBindsLR GhcRn GhcRn
meth_binds
; Core [FunDep]
fds1 <- [LHsFunDep GhcRn] -> MetaM (Core [FunDep])
repLFunDeps [LHsFunDep GhcRn]
fds
; [Core (M Dec)]
ats1 <- [LFamilyDecl GhcRn] -> MetaM [Core (M Dec)]
repFamilyDecls [LFamilyDecl GhcRn]
ats
; [Core (M Dec)]
atds1 <- (GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)
-> MetaM (Core (M Dec)))
-> [GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)]
-> MetaM [Core (M Dec)]
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 (TyFamDefltDecl GhcRn -> MetaM (Core (M Dec))
repAssocTyFamDefaultD (TyFamDefltDecl GhcRn -> MetaM (Core (M Dec)))
-> (GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)
-> TyFamDefltDecl GhcRn)
-> GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)
-> MetaM (Core (M Dec))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)
-> TyFamDefltDecl GhcRn
forall l e. GenLocated l e -> e
unLoc) [LTyFamDefltDecl GhcRn]
[GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)]
atds
; Core [M Dec]
decls1 <- Name
-> (Core (M Dec) -> MetaM (Core (M Dec)))
-> [Core (M Dec)]
-> MetaM (Core [M Dec])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
decTyConName Core (M Dec) -> MetaM (Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Core (M Dec)]
ats1 [Core (M Dec)] -> [Core (M Dec)] -> [Core (M Dec)]
forall a. [a] -> [a] -> [a]
++ [Core (M Dec)]
atds1 [Core (M Dec)] -> [Core (M Dec)] -> [Core (M Dec)]
forall a. [a] -> [a] -> [a]
++ [Core (M Dec)]
sigs_binds)
; Core (M Dec)
decls2 <- Core (M Cxt)
-> Core Name
-> Core [M (TyVarBndr ())]
-> Core [FunDep]
-> Core [M Dec]
-> MetaM (Core (M Dec))
repClass Core (M Cxt)
cxt1 Core Name
cls1 Core [M (TyVarBndr ())]
bndrs Core [FunDep]
fds1 Core [M Dec]
decls1
; [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
decls2 }
; Maybe (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec))))
-> Maybe (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec))
forall a. a -> Maybe a
Just (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec)
}
repRoleD :: LRoleAnnotDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repRoleD :: LRoleAnnotDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRoleD (L SrcSpanAnnA
loc (RoleAnnotDecl XCRoleAnnotDecl GhcRn
_ LIdP GhcRn
tycon [XRec GhcRn (Maybe Role)]
roles))
= do { Core Name
tycon1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
tycon
; [Core Role]
roles1 <- (LocatedAn NoEpAnns (Maybe Role)
-> ReaderT MetaWrappers DsM (Core Role))
-> [LocatedAn NoEpAnns (Maybe Role)]
-> ReaderT MetaWrappers DsM [Core Role]
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 LocatedAn NoEpAnns (Maybe Role)
-> ReaderT MetaWrappers DsM (Core Role)
repRole [XRec GhcRn (Maybe Role)]
[LocatedAn NoEpAnns (Maybe Role)]
roles
; Core [Role]
roles2 <- Name -> [Core Role] -> MetaM (Core [Role])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreList Name
roleTyConName [Core Role]
roles1
; Core (M Dec)
dec <- Core Name -> Core [Role] -> MetaM (Core (M Dec))
repRoleAnnotD Core Name
tycon1 Core [Role]
roles2
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec) }
repKiSigD :: LStandaloneKindSig GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repKiSigD :: LStandaloneKindSig GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repKiSigD (L SrcSpanAnnA
loc StandaloneKindSig GhcRn
kisig) =
case StandaloneKindSig GhcRn
kisig of
StandaloneKindSig XStandaloneKindSig GhcRn
_ LIdP GhcRn
v LHsSigType GhcRn
ki -> do
MkC CoreExpr
th_v <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
v
MkC CoreExpr
th_ki <- LHsSigType GhcRn -> MetaM (Core (M Type))
repHsSigType LHsSigType GhcRn
ki
Core (M Dec)
dec <- Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
kiSigDName [CoreExpr
th_v, CoreExpr
th_ki]
(SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec)
repDataDefn :: Core TH.Name
-> Either (Core [(M (TH.TyVarBndr ()))])
(Core (Maybe [(M (TH.TyVarBndr ()))]), Core (M TH.Type))
-> HsDataDefn GhcRn
-> MetaM (Core (M TH.Dec))
repDataDefn :: Core Name
-> Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> HsDataDefn GhcRn
-> MetaM (Core (M Dec))
repDataDefn Core Name
tc Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
opts
(HsDataDefn { dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ctxt = Maybe (LHsContext GhcRn)
cxt, dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (XRec GhcRn (HsType GhcRn))
ksig
, dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons = DataDefnCons (LConDecl GhcRn)
cons, dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs = HsDeriving GhcRn
mb_derivs })
= do { Core (M Cxt)
cxt1 <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
cxt
; Core [M DerivClause]
derivs1 <- HsDeriving GhcRn -> MetaM (Core [M DerivClause])
repDerivs HsDeriving GhcRn
mb_derivs
; case DataDefnCons (LConDecl GhcRn)
cons of
NewTypeCon LConDecl GhcRn
con -> do { Core (M Con)
con' <- LConDecl GhcRn -> MetaM (Core (M Con))
repC LConDecl GhcRn
con
; Core (Maybe (M Type))
ksig' <- Maybe (XRec GhcRn (HsType GhcRn)) -> MetaM (Core (Maybe (M Type)))
repMaybeLTy Maybe (XRec GhcRn (HsType GhcRn))
ksig
; Core (M Cxt)
-> Core Name
-> Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Core (Maybe (M Type))
-> Core (M Con)
-> Core [M DerivClause]
-> MetaM (Core (M Dec))
repNewtype Core (M Cxt)
cxt1 Core Name
tc Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
opts Core (Maybe (M Type))
ksig' Core (M Con)
con'
Core [M DerivClause]
derivs1 }
DataTypeCons Bool
type_data [LConDecl GhcRn]
cons -> do { Core (Maybe (M Type))
ksig' <- Maybe (XRec GhcRn (HsType GhcRn)) -> MetaM (Core (Maybe (M Type)))
repMaybeLTy Maybe (XRec GhcRn (HsType GhcRn))
ksig
; [Core (M Con)]
consL <- (GenLocated SrcSpanAnnA (ConDecl GhcRn) -> MetaM (Core (M Con)))
-> [GenLocated SrcSpanAnnA (ConDecl GhcRn)]
-> ReaderT MetaWrappers DsM [Core (M Con)]
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 LConDecl GhcRn -> MetaM (Core (M Con))
GenLocated SrcSpanAnnA (ConDecl GhcRn) -> MetaM (Core (M Con))
repC [LConDecl GhcRn]
[GenLocated SrcSpanAnnA (ConDecl GhcRn)]
cons
; Core [M Con]
cons1 <- Name -> [Core (M Con)] -> MetaM (Core [M Con])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
conTyConName [Core (M Con)]
consL
; Bool
-> Core (M Cxt)
-> Core Name
-> Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Core (Maybe (M Type))
-> Core [M Con]
-> Core [M DerivClause]
-> MetaM (Core (M Dec))
repData Bool
type_data Core (M Cxt)
cxt1 Core Name
tc Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
opts Core (Maybe (M Type))
ksig' Core [M Con]
cons1
Core [M DerivClause]
derivs1 }
}
repSynDecl :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
-> LHsType GhcRn
-> MetaM (Core (M TH.Dec))
repSynDecl :: Core Name
-> Core [M (TyVarBndr ())]
-> XRec GhcRn (HsType GhcRn)
-> MetaM (Core (M Dec))
repSynDecl Core Name
tc Core [M (TyVarBndr ())]
bndrs XRec GhcRn (HsType GhcRn)
ty
= do { Core (M Type)
ty1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ty
; Core Name
-> Core [M (TyVarBndr ())] -> Core (M Type) -> MetaM (Core (M Dec))
repTySyn Core Name
tc Core [M (TyVarBndr ())]
bndrs Core (M Type)
ty1 }
repFamilyDecl :: LFamilyDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repFamilyDecl :: LFamilyDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repFamilyDecl decl :: LFamilyDecl GhcRn
decl@(L SrcSpanAnnA
loc (FamilyDecl { fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = FamilyInfo GhcRn
info
, fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName = LIdP GhcRn
tc
, fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars = LHsQTyVars GhcRn
tvs
, fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdResultSig = L SrcAnn NoEpAnns
_ FamilyResultSig GhcRn
resultSig
, fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn GhcRn)
injectivity }))
= do { Core Name
tc1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
tc
; let resTyVar :: [Name]
resTyVar = case FamilyResultSig GhcRn
resultSig of
TyVarSig XTyVarSig GhcRn
_ LHsTyVarBndr () GhcRn
bndr -> [LHsTyVarBndr () GhcRn -> IdP GhcRn
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName LHsTyVarBndr () GhcRn
bndr]
FamilyResultSig GhcRn
_ -> []
; Core (M Dec)
dec <- FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addQTyVarBinds FreshOrReuse
ReuseBoundNames LHsQTyVars GhcRn
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
FreshOrReuse
-> [Name] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a.
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
ReuseBoundNames [Name]
resTyVar (MetaM (Core (M Dec)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$
case FamilyInfo GhcRn
info of
ClosedTypeFamily Maybe [LTyFamInstEqn GhcRn]
Nothing ->
ThRejectionReason -> MetaM (Core (M Dec))
forall a. ThRejectionReason -> MetaM a
notHandled (LFamilyDecl GhcRn -> ThRejectionReason
ThAbstractClosedTypeFamily LFamilyDecl GhcRn
decl)
ClosedTypeFamily (Just [LTyFamInstEqn GhcRn]
eqns) ->
do { [Core (M TySynEqn)]
eqns1 <- (GenLocated
SrcSpanAnnA (FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> [GenLocated
SrcSpanAnnA (FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))]
-> ReaderT MetaWrappers DsM [Core (M TySynEqn)]
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 (TyFamInstEqn GhcRn -> ReaderT MetaWrappers DsM (Core (M TySynEqn))
FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTyFamEqn (FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> (GenLocated
SrcSpanAnnA (FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> GenLocated
SrcSpanAnnA (FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnA (FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
forall l e. GenLocated l e -> e
unLoc) [LTyFamInstEqn GhcRn]
[GenLocated
SrcSpanAnnA (FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))]
eqns
; Core [M TySynEqn]
eqns2 <- Name -> [Core (M TySynEqn)] -> MetaM (Core [M TySynEqn])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
tySynEqnTyConName [Core (M TySynEqn)]
eqns1
; Core (M FamilyResultSig)
result <- FamilyResultSig GhcRn -> MetaM (Core (M FamilyResultSig))
repFamilyResultSig FamilyResultSig GhcRn
resultSig
; Core (Maybe InjectivityAnn)
inj <- Maybe (LInjectivityAnn GhcRn)
-> MetaM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn GhcRn)
injectivity
; Core Name
-> Core [M (TyVarBndr ())]
-> Core (M FamilyResultSig)
-> Core (Maybe InjectivityAnn)
-> Core [M TySynEqn]
-> MetaM (Core (M Dec))
repClosedFamilyD Core Name
tc1 Core [M (TyVarBndr ())]
bndrs Core (M FamilyResultSig)
result Core (Maybe InjectivityAnn)
inj Core [M TySynEqn]
eqns2 }
FamilyInfo GhcRn
OpenTypeFamily ->
do { Core (M FamilyResultSig)
result <- FamilyResultSig GhcRn -> MetaM (Core (M FamilyResultSig))
repFamilyResultSig FamilyResultSig GhcRn
resultSig
; Core (Maybe InjectivityAnn)
inj <- Maybe (LInjectivityAnn GhcRn)
-> MetaM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn GhcRn)
injectivity
; Core Name
-> Core [M (TyVarBndr ())]
-> Core (M FamilyResultSig)
-> Core (Maybe InjectivityAnn)
-> MetaM (Core (M Dec))
repOpenFamilyD Core Name
tc1 Core [M (TyVarBndr ())]
bndrs Core (M FamilyResultSig)
result Core (Maybe InjectivityAnn)
inj }
FamilyInfo GhcRn
DataFamily ->
do { Core (Maybe (M Type))
kind <- FamilyResultSig GhcRn -> MetaM (Core (Maybe (M Type)))
repFamilyResultSigToMaybeKind FamilyResultSig GhcRn
resultSig
; Core Name
-> Core [M (TyVarBndr ())]
-> Core (Maybe (M Type))
-> MetaM (Core (M Dec))
repDataFamilyD Core Name
tc1 Core [M (TyVarBndr ())]
bndrs Core (Maybe (M Type))
kind }
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec)
}
repFamilyResultSig :: FamilyResultSig GhcRn -> MetaM (Core (M TH.FamilyResultSig))
repFamilyResultSig :: FamilyResultSig GhcRn -> MetaM (Core (M FamilyResultSig))
repFamilyResultSig (NoSig XNoSig GhcRn
_) = MetaM (Core (M FamilyResultSig))
repNoSig
repFamilyResultSig (KindSig XCKindSig GhcRn
_ XRec GhcRn (HsType GhcRn)
ki) = do { Core (M Type)
ki' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ki
; Core (M Type) -> MetaM (Core (M FamilyResultSig))
repKindSig Core (M Type)
ki' }
repFamilyResultSig (TyVarSig XTyVarSig GhcRn
_ LHsTyVarBndr () GhcRn
bndr) = do { Core (M (TyVarBndr ()))
bndr' <- LHsTyVarBndr () GhcRn -> MetaM (Core (M (TyVarBndr ())))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr LHsTyVarBndr () GhcRn
bndr
; Core (M (TyVarBndr ())) -> MetaM (Core (M FamilyResultSig))
repTyVarSig Core (M (TyVarBndr ()))
bndr' }
repFamilyResultSigToMaybeKind :: FamilyResultSig GhcRn
-> MetaM (Core (Maybe (M TH.Kind)))
repFamilyResultSigToMaybeKind :: FamilyResultSig GhcRn -> MetaM (Core (Maybe (M Type)))
repFamilyResultSigToMaybeKind (NoSig XNoSig GhcRn
_) =
Name -> MetaM (Core (Maybe (M Type)))
forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
kindTyConName
repFamilyResultSigToMaybeKind (KindSig XCKindSig GhcRn
_ XRec GhcRn (HsType GhcRn)
ki) =
Name -> Core (M Type) -> MetaM (Core (Maybe (M Type)))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJustM Name
kindTyConName (Core (M Type) -> MetaM (Core (Maybe (M Type))))
-> MetaM (Core (M Type)) -> MetaM (Core (Maybe (M Type)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ki
repFamilyResultSigToMaybeKind TyVarSig{} =
String -> MetaM (Core (Maybe (M Type)))
forall a. HasCallStack => String -> a
panic String
"repFamilyResultSigToMaybeKind: unexpected TyVarSig"
repInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
-> MetaM (Core (Maybe TH.InjectivityAnn))
repInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
-> MetaM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn GhcRn)
Nothing =
Name -> MetaM (Core (Maybe InjectivityAnn))
forall a. Name -> MetaM (Core (Maybe a))
coreNothing Name
injAnnTyConName
repInjectivityAnn (Just (L SrcAnn NoEpAnns
_ (InjectivityAnn XCInjectivityAnn GhcRn
_ LIdP GhcRn
lhs [LIdP GhcRn]
rhs))) =
do { Core Name
lhs' <- Name -> MetaM (Core Name)
lookupBinder (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
lhs)
; [Core Name]
rhs1 <- (GenLocated SrcSpanAnnN Name -> MetaM (Core Name))
-> [GenLocated SrcSpanAnnN Name]
-> ReaderT MetaWrappers DsM [Core Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Name -> MetaM (Core Name)
lookupBinder (Name -> MetaM (Core Name))
-> (GenLocated SrcSpanAnnN Name -> Name)
-> GenLocated SrcSpanAnnN Name
-> MetaM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc) [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
rhs
; Core [Name]
rhs2 <- Name -> [Core Name] -> MetaM (Core [Name])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreList Name
nameTyConName [Core Name]
rhs1
; Core InjectivityAnn
injAnn <- Name -> [CoreExpr] -> MetaM (Core InjectivityAnn)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
injectivityAnnName [Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC Core Name
lhs', Core [Name] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [Name]
rhs2]
; Name -> Core InjectivityAnn -> MetaM (Core (Maybe InjectivityAnn))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJust Name
injAnnTyConName Core InjectivityAnn
injAnn }
repFamilyDecls :: [LFamilyDecl GhcRn] -> MetaM [Core (M TH.Dec)]
repFamilyDecls :: [LFamilyDecl GhcRn] -> MetaM [Core (M Dec)]
repFamilyDecls [LFamilyDecl GhcRn]
fds = ([(SrcSpan, Core (M Dec))] -> [Core (M Dec)])
-> MetaM [(SrcSpan, Core (M Dec))] -> MetaM [Core (M Dec)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ((GenLocated SrcSpanAnnA (FamilyDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (FamilyDecl GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LFamilyDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (FamilyDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repFamilyDecl [LFamilyDecl GhcRn]
[GenLocated SrcSpanAnnA (FamilyDecl GhcRn)]
fds)
repAssocTyFamDefaultD :: TyFamDefltDecl GhcRn -> MetaM (Core (M TH.Dec))
repAssocTyFamDefaultD :: TyFamDefltDecl GhcRn -> MetaM (Core (M Dec))
repAssocTyFamDefaultD = TyFamDefltDecl GhcRn -> MetaM (Core (M Dec))
repTyFamInstD
repLFunDeps :: [LHsFunDep GhcRn] -> MetaM (Core [TH.FunDep])
repLFunDeps :: [LHsFunDep GhcRn] -> MetaM (Core [FunDep])
repLFunDeps [LHsFunDep GhcRn]
fds = Name
-> (GenLocated SrcSpanAnnA (FunDep GhcRn) -> MetaM (Core FunDep))
-> [GenLocated SrcSpanAnnA (FunDep GhcRn)]
-> MetaM (Core [FunDep])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
funDepTyConName LHsFunDep GhcRn -> MetaM (Core FunDep)
GenLocated SrcSpanAnnA (FunDep GhcRn) -> MetaM (Core FunDep)
repLFunDep [LHsFunDep GhcRn]
[GenLocated SrcSpanAnnA (FunDep GhcRn)]
fds
repLFunDep :: LHsFunDep GhcRn -> MetaM (Core TH.FunDep)
repLFunDep :: LHsFunDep GhcRn -> MetaM (Core FunDep)
repLFunDep (L SrcSpanAnnA
_ (FunDep XCFunDep GhcRn
_ [LIdP GhcRn]
xs [LIdP GhcRn]
ys))
= do Core [Name]
xs' <- Name
-> (GenLocated SrcSpanAnnN Name -> MetaM (Core Name))
-> [GenLocated SrcSpanAnnN Name]
-> MetaM (Core [Name])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
nameTyConName (Name -> MetaM (Core Name)
lookupBinder (Name -> MetaM (Core Name))
-> (GenLocated SrcSpanAnnN Name -> Name)
-> GenLocated SrcSpanAnnN Name
-> MetaM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc) [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
xs
Core [Name]
ys' <- Name
-> (GenLocated SrcSpanAnnN Name -> MetaM (Core Name))
-> [GenLocated SrcSpanAnnN Name]
-> MetaM (Core [Name])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
nameTyConName (Name -> MetaM (Core Name)
lookupBinder (Name -> MetaM (Core Name))
-> (GenLocated SrcSpanAnnN Name -> Name)
-> GenLocated SrcSpanAnnN Name
-> MetaM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc) [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
ys
Core [Name] -> Core [Name] -> MetaM (Core FunDep)
repFunDep Core [Name]
xs' Core [Name]
ys'
repInstD :: LInstDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repInstD :: LInstDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repInstD (L SrcSpanAnnA
loc (TyFamInstD { tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
tfid_inst = TyFamDefltDecl GhcRn
fi_decl }))
= do { Core (M Dec)
dec <- TyFamDefltDecl GhcRn -> MetaM (Core (M Dec))
repTyFamInstD TyFamDefltDecl GhcRn
fi_decl
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec) }
repInstD (L SrcSpanAnnA
loc (DataFamInstD { dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst = DataFamInstDecl GhcRn
fi_decl }))
= do { Core (M Dec)
dec <- DataFamInstDecl GhcRn -> MetaM (Core (M Dec))
repDataFamInstD DataFamInstDecl GhcRn
fi_decl
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec) }
repInstD (L SrcSpanAnnA
loc (ClsInstD { cid_inst :: forall pass. InstDecl pass -> ClsInstDecl pass
cid_inst = ClsInstDecl GhcRn
cls_decl }))
= do { Core (M Dec)
dec <- ClsInstDecl GhcRn -> MetaM (Core (M Dec))
repClsInstD ClsInstDecl GhcRn
cls_decl
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec) }
repClsInstD :: ClsInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repClsInstD :: ClsInstDecl GhcRn -> MetaM (Core (M Dec))
repClsInstD (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType GhcRn
ty, cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds = LHsBindsLR GhcRn GhcRn
binds
, cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_sigs = [LSig GhcRn]
sigs, cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts = [LTyFamDefltDecl GhcRn]
ats
, cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts = [LDataFamInstDecl GhcRn]
adts
, cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (XRec pass OverlapMode)
cid_overlap_mode = Maybe (XRec GhcRn OverlapMode)
overlap
})
= FreshOrReuse
-> [Name] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a.
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
FreshNamesOnly [Name]
tvs (MetaM (Core (M Dec)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$
do { Core (M Cxt)
cxt1 <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
cxt
; Core (M Type)
inst_ty1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
inst_ty
; ([GenSymBind]
ss, [Core (M Dec)]
sigs_binds) <- [LSig GhcRn]
-> LHsBindsLR GhcRn GhcRn -> MetaM ([GenSymBind], [Core (M Dec)])
rep_meth_sigs_binds [LSig GhcRn]
sigs LHsBindsLR GhcRn GhcRn
binds
; [Core (M Dec)]
ats1 <- (GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)
-> MetaM (Core (M Dec)))
-> [GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)]
-> MetaM [Core (M Dec)]
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 (TyFamDefltDecl GhcRn -> MetaM (Core (M Dec))
repTyFamInstD (TyFamDefltDecl GhcRn -> MetaM (Core (M Dec)))
-> (GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)
-> TyFamDefltDecl GhcRn)
-> GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)
-> MetaM (Core (M Dec))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)
-> TyFamDefltDecl GhcRn
forall l e. GenLocated l e -> e
unLoc) [LTyFamDefltDecl GhcRn]
[GenLocated SrcSpanAnnA (TyFamDefltDecl GhcRn)]
ats
; [Core (M Dec)]
adts1 <- (GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)
-> MetaM (Core (M Dec)))
-> [GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)]
-> MetaM [Core (M Dec)]
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 (DataFamInstDecl GhcRn -> MetaM (Core (M Dec))
repDataFamInstD (DataFamInstDecl GhcRn -> MetaM (Core (M Dec)))
-> (GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)
-> DataFamInstDecl GhcRn)
-> GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)
-> MetaM (Core (M Dec))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)
-> DataFamInstDecl GhcRn
forall l e. GenLocated l e -> e
unLoc) [LDataFamInstDecl GhcRn]
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)]
adts
; Core [M Dec]
decls1 <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName ([Core (M Dec)]
ats1 [Core (M Dec)] -> [Core (M Dec)] -> [Core (M Dec)]
forall a. [a] -> [a] -> [a]
++ [Core (M Dec)]
adts1 [Core (M Dec)] -> [Core (M Dec)] -> [Core (M Dec)]
forall a. [a] -> [a] -> [a]
++ [Core (M Dec)]
sigs_binds)
; Core (Maybe Overlap)
rOver <- Maybe OverlapMode -> MetaM (Core (Maybe Overlap))
repOverlap ((GenLocated SrcSpanAnnP OverlapMode -> OverlapMode)
-> Maybe (GenLocated SrcSpanAnnP OverlapMode) -> Maybe OverlapMode
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnP OverlapMode -> OverlapMode
forall l e. GenLocated l e -> e
unLoc Maybe (XRec GhcRn OverlapMode)
Maybe (GenLocated SrcSpanAnnP OverlapMode)
overlap)
; Core (M Dec)
decls2 <- Core (Maybe Overlap)
-> Core (M Cxt)
-> Core (M Type)
-> Core [M Dec]
-> MetaM (Core (M Dec))
repInst Core (Maybe Overlap)
rOver Core (M Cxt)
cxt1 Core (M Type)
inst_ty1 Core [M Dec]
decls1
; [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
decls2 }
where
([Name]
tvs, Maybe (LHsContext GhcRn)
cxt, XRec GhcRn (HsType GhcRn)
inst_ty) = LHsSigType GhcRn
-> ([Name], Maybe (LHsContext GhcRn), XRec GhcRn (HsType GhcRn))
splitLHsInstDeclTy LHsSigType GhcRn
ty
repStandaloneDerivD :: LDerivDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repStandaloneDerivD :: LDerivDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repStandaloneDerivD (L SrcSpanAnnA
loc (DerivDecl { deriv_strategy :: forall pass. DerivDecl pass -> Maybe (LDerivStrategy pass)
deriv_strategy = Maybe (LDerivStrategy GhcRn)
strat
, deriv_type :: forall pass. DerivDecl pass -> LHsSigWcType pass
deriv_type = LHsSigWcType GhcRn
ty }))
= do { Core (M Dec)
dec <- Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy Maybe (LDerivStrategy GhcRn)
strat ((Core (Maybe (M DerivStrategy)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)))
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core (Maybe (M DerivStrategy))
strat' ->
FreshOrReuse
-> [Name] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a.
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
FreshNamesOnly [Name]
tvs (MetaM (Core (M Dec)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$
do { Core (M Cxt)
cxt' <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
cxt
; Core (M Type)
inst_ty' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
inst_ty
; Core (Maybe (M DerivStrategy))
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Dec))
repDeriv Core (Maybe (M DerivStrategy))
strat' Core (M Cxt)
cxt' Core (M Type)
inst_ty' }
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec) }
where
([Name]
tvs, Maybe (LHsContext GhcRn)
cxt, XRec GhcRn (HsType GhcRn)
inst_ty) = LHsSigType GhcRn
-> ([Name], Maybe (LHsContext GhcRn), XRec GhcRn (HsType GhcRn))
splitLHsInstDeclTy (LHsSigWcType GhcRn -> LHsSigType GhcRn
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType GhcRn
ty)
repTyFamInstD :: TyFamInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repTyFamInstD :: TyFamDefltDecl GhcRn -> MetaM (Core (M Dec))
repTyFamInstD (TyFamInstDecl { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn = TyFamInstEqn GhcRn
eqn })
= do { Core (M TySynEqn)
eqn1 <- TyFamInstEqn GhcRn -> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTyFamEqn TyFamInstEqn GhcRn
eqn
; Core (M TySynEqn) -> MetaM (Core (M Dec))
repTySynInst Core (M TySynEqn)
eqn1 }
repTyFamEqn :: TyFamInstEqn GhcRn -> MetaM (Core (M TH.TySynEqn))
repTyFamEqn :: TyFamInstEqn GhcRn -> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTyFamEqn (FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = LIdP GhcRn
tc_name
, feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcRn
outer_bndrs
, feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats = HsTyPats GhcRn
tys
, feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_fixity = LexicalFixity
fixity
, feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = XRec GhcRn (HsType GhcRn)
rhs })
= do { Core Name
tc <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
tc_name
; HsOuterFamEqnTyVarBndrs GhcRn
-> (Core (Maybe [M (TyVarBndr ())])
-> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
forall a.
HsOuterFamEqnTyVarBndrs GhcRn
-> (Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterFamEqnTyVarBinds HsOuterFamEqnTyVarBndrs GhcRn
outer_bndrs ((Core (Maybe [M (TyVarBndr ())])
-> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> (Core (Maybe [M (TyVarBndr ())])
-> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
forall a b. (a -> b) -> a -> b
$ \Core (Maybe [M (TyVarBndr ())])
mb_exp_bndrs ->
do { Core (M Type)
tys1 <- case LexicalFixity
fixity of
LexicalFixity
Prefix -> MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core Name -> MetaM (Core (M Type))
repNamedTyCon Core Name
tc) HsTyPats GhcRn
tys
LexicalFixity
Infix -> do { (HsValArg GenLocated SrcSpanAnnA (HsType GhcRn)
t1: HsValArg GenLocated SrcSpanAnnA (HsType GhcRn)
t2: [HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
args) <- HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
checkTys HsTyPats GhcRn
tys
; Core (M Type)
t1' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
t1
; Core (M Type)
t2' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
t2
; MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core (M Type)
-> Core Name -> Core (M Type) -> MetaM (Core (M Type))
repTInfix Core (M Type)
t1' Core Name
tc Core (M Type)
t2') HsTyPats GhcRn
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
args }
; Core (M Type)
rhs1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
rhs
; Core (Maybe [M (TyVarBndr ())])
-> Core (M Type)
-> Core (M Type)
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTySynEqn Core (Maybe [M (TyVarBndr ())])
mb_exp_bndrs Core (M Type)
tys1 Core (M Type)
rhs1 } }
where checkTys :: [LHsTypeArg GhcRn] -> MetaM [LHsTypeArg GhcRn]
checkTys :: HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
checkTys tys :: HsTyPats GhcRn
tys@(HsValArg XRec GhcRn (HsType GhcRn)
_:HsValArg XRec GhcRn (HsType GhcRn)
_:HsTyPats GhcRn
_) = [HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
-> ReaderT
MetaWrappers
DsM
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return HsTyPats GhcRn
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
tys
checkTys HsTyPats GhcRn
_ = String
-> ReaderT
MetaWrappers
DsM
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
forall a. HasCallStack => String -> a
panic String
"repTyFamEqn:checkTys"
repTyArgs :: MetaM (Core (M TH.Type)) -> [LHsTypeArg GhcRn] -> MetaM (Core (M TH.Type))
repTyArgs :: MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs MetaM (Core (M Type))
f [] = MetaM (Core (M Type))
f
repTyArgs MetaM (Core (M Type))
f (HsValArg XRec GhcRn (HsType GhcRn)
ty : HsTyPats GhcRn
as) = do { Core (M Type)
f' <- MetaM (Core (M Type))
f
; Core (M Type)
ty' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ty
; MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
f' Core (M Type)
ty') HsTyPats GhcRn
as }
repTyArgs MetaM (Core (M Type))
f (HsTypeArg SrcSpan
_ XRec GhcRn (HsType GhcRn)
ki : HsTyPats GhcRn
as) = do { Core (M Type)
f' <- MetaM (Core (M Type))
f
; Core (M Type)
ki' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ki
; MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTappKind Core (M Type)
f' Core (M Type)
ki') HsTyPats GhcRn
as }
repTyArgs MetaM (Core (M Type))
f (HsArgPar SrcSpan
_ : HsTyPats GhcRn
as) = MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs MetaM (Core (M Type))
f HsTyPats GhcRn
as
repDataFamInstD :: DataFamInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repDataFamInstD :: DataFamInstDecl GhcRn -> MetaM (Core (M Dec))
repDataFamInstD (DataFamInstDecl { dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn =
FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = LIdP GhcRn
tc_name
, feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_bndrs = HsOuterFamEqnTyVarBndrs GhcRn
outer_bndrs
, feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats = HsTyPats GhcRn
tys
, feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_fixity = LexicalFixity
fixity
, feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = HsDataDefn GhcRn
defn }})
= do { Core Name
tc <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
tc_name
; HsOuterFamEqnTyVarBndrs GhcRn
-> (Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
HsOuterFamEqnTyVarBndrs GhcRn
-> (Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterFamEqnTyVarBinds HsOuterFamEqnTyVarBndrs GhcRn
outer_bndrs ((Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)))
-> (Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core (Maybe [M (TyVarBndr ())])
mb_exp_bndrs ->
do { Core (M Type)
tys1 <- case LexicalFixity
fixity of
LexicalFixity
Prefix -> MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core Name -> MetaM (Core (M Type))
repNamedTyCon Core Name
tc) HsTyPats GhcRn
tys
LexicalFixity
Infix -> do { (HsValArg GenLocated SrcSpanAnnA (HsType GhcRn)
t1: HsValArg GenLocated SrcSpanAnnA (HsType GhcRn)
t2: [HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
args) <- HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
checkTys HsTyPats GhcRn
tys
; Core (M Type)
t1' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
t1
; Core (M Type)
t2' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
t2
; MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core (M Type)
-> Core Name -> Core (M Type) -> MetaM (Core (M Type))
repTInfix Core (M Type)
t1' Core Name
tc Core (M Type)
t2') HsTyPats GhcRn
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
args }
; Core Name
-> Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> HsDataDefn GhcRn
-> MetaM (Core (M Dec))
repDataDefn Core Name
tc ((Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
forall a b. b -> Either a b
Right (Core (Maybe [M (TyVarBndr ())])
mb_exp_bndrs, Core (M Type)
tys1)) HsDataDefn GhcRn
defn } }
where checkTys :: [LHsTypeArg GhcRn] -> MetaM [LHsTypeArg GhcRn]
checkTys :: HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
checkTys tys :: HsTyPats GhcRn
tys@(HsValArg XRec GhcRn (HsType GhcRn)
_: HsValArg XRec GhcRn (HsType GhcRn)
_: HsTyPats GhcRn
_) = [HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
-> ReaderT
MetaWrappers
DsM
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return HsTyPats GhcRn
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
tys
checkTys HsTyPats GhcRn
_ = String
-> ReaderT
MetaWrappers
DsM
[HsArg
(GenLocated SrcSpanAnnA (HsType GhcRn))
(GenLocated SrcSpanAnnA (HsType GhcRn))]
forall a. HasCallStack => String -> a
panic String
"repDataFamInstD:checkTys"
repForD :: LForeignDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repForD :: LForeignDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repForD (L SrcSpanAnnA
loc (ForeignImport { fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name = LIdP GhcRn
name, fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty = LHsSigType GhcRn
typ
, fd_fi :: forall pass. ForeignDecl pass -> ForeignImport pass
fd_fi = CImport XCImport GhcRn
_ (L SrcSpan
_ CCallConv
cc)
(L SrcSpan
_ Safety
s) Maybe Header
mch CImportSpec
cis }))
= do MkC CoreExpr
name' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
name
MkC CoreExpr
typ' <- LHsSigType GhcRn -> MetaM (Core (M Type))
repHsSigType LHsSigType GhcRn
typ
MkC CoreExpr
cc' <- CCallConv -> MetaM (Core Callconv)
repCCallConv CCallConv
cc
MkC CoreExpr
s' <- Safety -> MetaM (Core Safety)
repSafety Safety
s
String
cis' <- CImportSpec -> MetaM String
conv_cimportspec CImportSpec
cis
MkC CoreExpr
str <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit (String -> FastString
mkFastString (String
static String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
chStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cis'))
Core (M Dec)
dec <- Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forImpDName [CoreExpr
cc', CoreExpr
s', CoreExpr
str, CoreExpr
name', CoreExpr
typ']
(SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec)
where
conv_cimportspec :: CImportSpec -> MetaM String
conv_cimportspec (CLabel FastString
cls)
= ThRejectionReason -> MetaM String
forall a. ThRejectionReason -> MetaM a
notHandled (FastString -> ThRejectionReason
ThForeignLabel FastString
cls)
conv_cimportspec (CFunction CCallTarget
DynamicTarget) = String -> MetaM String
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"dynamic"
conv_cimportspec (CFunction (StaticTarget SourceText
_ FastString
fs Maybe Unit
_ Bool
True))
= String -> MetaM String
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> String
unpackFS FastString
fs)
conv_cimportspec (CFunction (StaticTarget SourceText
_ FastString
_ Maybe Unit
_ Bool
False))
= String -> MetaM String
forall a. HasCallStack => String -> a
panic String
"conv_cimportspec: values not supported yet"
conv_cimportspec CImportSpec
CWrapper = String -> MetaM String
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"wrapper"
raw_cconv :: Bool
raw_cconv = CCallConv
cc CCallConv -> CCallConv -> Bool
forall a. Eq a => a -> a -> Bool
== CCallConv
PrimCallConv Bool -> Bool -> Bool
|| CCallConv
cc CCallConv -> CCallConv -> Bool
forall a. Eq a => a -> a -> Bool
== CCallConv
JavaScriptCallConv
static :: String
static = case CImportSpec
cis of
CFunction (StaticTarget SourceText
_ FastString
_ Maybe Unit
_ Bool
_) | Bool -> Bool
not Bool
raw_cconv -> String
"static "
CImportSpec
_ -> String
""
chStr :: String
chStr = case Maybe Header
mch of
Just (Header SourceText
_ FastString
h) | Bool -> Bool
not Bool
raw_cconv -> FastString -> String
unpackFS FastString
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
Maybe Header
_ -> String
""
repForD decl :: LForeignDecl GhcRn
decl@(L SrcSpanAnnA
_ ForeignExport{}) = ThRejectionReason
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. ThRejectionReason -> MetaM a
notHandled (LForeignDecl GhcRn -> ThRejectionReason
ThForeignExport LForeignDecl GhcRn
decl)
repCCallConv :: CCallConv -> MetaM (Core TH.Callconv)
repCCallConv :: CCallConv -> MetaM (Core Callconv)
repCCallConv CCallConv
CCallConv = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
cCallName []
repCCallConv CCallConv
StdCallConv = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
stdCallName []
repCCallConv CCallConv
CApiConv = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
cApiCallName []
repCCallConv CCallConv
PrimCallConv = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
primCallName []
repCCallConv CCallConv
JavaScriptCallConv = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
javaScriptCallName []
repSafety :: Safety -> MetaM (Core TH.Safety)
repSafety :: Safety -> MetaM (Core Safety)
repSafety Safety
PlayRisky = Name -> [CoreExpr] -> MetaM (Core Safety)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
unsafeName []
repSafety Safety
PlayInterruptible = Name -> [CoreExpr] -> MetaM (Core Safety)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
interruptibleName []
repSafety Safety
PlaySafe = Name -> [CoreExpr] -> MetaM (Core Safety)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
safeName []
repLFixD :: LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
repLFixD :: LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
repLFixD (L SrcSpanAnnA
loc FixitySig GhcRn
fix_sig) = SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_fix_d (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) FixitySig GhcRn
fix_sig
rep_fix_d :: SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_fix_d :: SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_fix_d SrcSpan
loc (FixitySig XFixitySig GhcRn
_ [LIdP GhcRn]
names (Fixity SourceText
_ Int
prec FixityDirection
dir))
= do { MkC CoreExpr
prec' <- Int -> MetaM (Core Int)
coreIntLit Int
prec
; let rep_fn :: Name
rep_fn = case FixityDirection
dir of
FixityDirection
InfixL -> Name
infixLDName
FixityDirection
InfixR -> Name
infixRDName
FixityDirection
InfixN -> Name
infixNDName
; let do_one :: GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
do_one GenLocated SrcSpanAnnN Name
name
= do { MkC CoreExpr
name' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
name
; Core (M Dec)
dec <- Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
rep_fn [CoreExpr
prec', CoreExpr
name']
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc,Core (M Dec)
dec) }
; (GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnN Name] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
do_one [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
names }
repDefD :: LDefaultDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repDefD :: LDefaultDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repDefD (L SrcSpanAnnA
loc (DefaultDecl XCDefaultDecl GhcRn
_ [XRec GhcRn (HsType GhcRn)]
tys)) = do { [Core (M Type)]
tys1 <- [XRec GhcRn (HsType GhcRn)] -> MetaM [Core (M Type)]
repLTys [XRec GhcRn (HsType GhcRn)]
tys
; MkC CoreExpr
tys2 <- Name -> [Core (M Type)] -> MetaM (Core [M Type])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
typeTyConName [Core (M Type)]
tys1
; Core (M Dec)
dec <- Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
defaultDName [CoreExpr
tys2]
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec)}
repRuleD :: LRuleDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repRuleD :: LRuleDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRuleD (L SrcSpanAnnA
loc (HsRule { rd_name :: forall pass. RuleDecl pass -> XRec pass FastString
rd_name = XRec GhcRn FastString
n
, rd_act :: forall pass. RuleDecl pass -> Activation
rd_act = Activation
act
, rd_tyvs :: forall pass.
RuleDecl pass -> Maybe [LHsTyVarBndr () (NoGhcTc pass)]
rd_tyvs = Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
m_ty_bndrs
, rd_tmvs :: forall pass. RuleDecl pass -> [LRuleBndr pass]
rd_tmvs = [LRuleBndr GhcRn]
tm_bndrs
, rd_lhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_lhs = LHsExpr GhcRn
lhs
, rd_rhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_rhs = LHsExpr GhcRn
rhs }))
= do { let ty_bndrs :: [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)]
ty_bndrs = [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)]
-> Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)]
m_ty_bndrs
; Core (M Dec)
rule <- FreshOrReuse
-> [LHsTyVarBndr () GhcRn]
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr () GhcRn]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)]
ty_bndrs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \ Core [M (TyVarBndr ())]
ex_bndrs ->
do { let tm_bndr_names :: [Name]
tm_bndr_names = (GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcRn) -> [Name])
-> [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcRn)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LRuleBndr GhcRn -> [Name]
GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcRn) -> [Name]
ruleBndrNames [LRuleBndr GhcRn]
[GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcRn)]
tm_bndrs
; [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
tm_bndr_names
; Core (M Dec)
rule <- [GenSymBind] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (MetaM (Core (M Dec)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$
do { Type
elt_ty <- Name -> MetaM Type
wrapName Name
tyVarBndrUnitTyConName
; Core (Maybe [M (TyVarBndr ())])
ty_bndrs' <- Core (Maybe [M (TyVarBndr ())])
-> ReaderT MetaWrappers DsM (Core (Maybe [M (TyVarBndr ())]))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Core (Maybe [M (TyVarBndr ())])
-> ReaderT MetaWrappers DsM (Core (Maybe [M (TyVarBndr ())])))
-> Core (Maybe [M (TyVarBndr ())])
-> ReaderT MetaWrappers DsM (Core (Maybe [M (TyVarBndr ())]))
forall a b. (a -> b) -> a -> b
$ case Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
m_ty_bndrs of
Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
Nothing -> Type -> Core (Maybe [M (TyVarBndr ())])
forall a. Type -> Core (Maybe a)
coreNothing' (Type -> Type
mkListTy Type
elt_ty)
Just [LHsTyVarBndr () (NoGhcTc GhcRn)]
_ -> Type -> Core [M (TyVarBndr ())] -> Core (Maybe [M (TyVarBndr ())])
forall a. Type -> Core a -> Core (Maybe a)
coreJust' (Type -> Type
mkListTy Type
elt_ty) Core [M (TyVarBndr ())]
ex_bndrs
; Core [M RuleBndr]
tm_bndrs' <- Name
-> (GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcRn)
-> MetaM (Core (M RuleBndr)))
-> [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcRn)]
-> MetaM (Core [M RuleBndr])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
ruleBndrTyConName
LRuleBndr GhcRn -> MetaM (Core (M RuleBndr))
GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcRn)
-> MetaM (Core (M RuleBndr))
repRuleBndr
[LRuleBndr GhcRn]
[GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcRn)]
tm_bndrs
; Core String
n' <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit (FastString -> ReaderT MetaWrappers DsM (Core String))
-> FastString -> ReaderT MetaWrappers DsM (Core String)
forall a b. (a -> b) -> a -> b
$ GenLocated (SrcAnn NoEpAnns) FastString -> FastString
forall l e. GenLocated l e -> e
unLoc XRec GhcRn FastString
GenLocated (SrcAnn NoEpAnns) FastString
n
; Core Phases
act' <- Activation -> MetaM (Core Phases)
repPhases Activation
act
; Core (M Exp)
lhs' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
lhs
; Core (M Exp)
rhs' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
rhs
; Core String
-> Core (Maybe [M (TyVarBndr ())])
-> Core [M RuleBndr]
-> Core (M Exp)
-> Core (M Exp)
-> Core Phases
-> MetaM (Core (M Dec))
repPragRule Core String
n' Core (Maybe [M (TyVarBndr ())])
ty_bndrs' Core [M RuleBndr]
tm_bndrs' Core (M Exp)
lhs' Core (M Exp)
rhs' Core Phases
act' }
; [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
rule }
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
rule) }
ruleBndrNames :: LRuleBndr GhcRn -> [Name]
ruleBndrNames :: LRuleBndr GhcRn -> [Name]
ruleBndrNames (L SrcAnn NoEpAnns
_ (RuleBndr XCRuleBndr GhcRn
_ LIdP GhcRn
n)) = [GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
n]
ruleBndrNames (L SrcAnn NoEpAnns
_ (RuleBndrSig XRuleBndrSig GhcRn
_ LIdP GhcRn
n HsPatSigType GhcRn
sig))
| HsPS { hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_ext = HsPSRn { hsps_imp_tvs :: HsPSRn -> [Name]
hsps_imp_tvs = [Name]
vars }} <- HsPatSigType GhcRn
sig
= GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
vars
repRuleBndr :: LRuleBndr GhcRn -> MetaM (Core (M TH.RuleBndr))
repRuleBndr :: LRuleBndr GhcRn -> MetaM (Core (M RuleBndr))
repRuleBndr (L SrcAnn NoEpAnns
_ (RuleBndr XCRuleBndr GhcRn
_ LIdP GhcRn
n))
= do { MkC CoreExpr
n' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP GhcRn
GenLocated SrcSpanAnnN Name
n
; Name -> [CoreExpr] -> MetaM (Core (M RuleBndr))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
ruleVarName [CoreExpr
n'] }
repRuleBndr (L SrcAnn NoEpAnns
_ (RuleBndrSig XRuleBndrSig GhcRn
_ LIdP GhcRn
n HsPatSigType GhcRn
sig))
= do { MkC CoreExpr
n' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP GhcRn
GenLocated SrcSpanAnnN Name
n
; MkC CoreExpr
ty' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy (HsPatSigType GhcRn -> XRec GhcRn (HsType GhcRn)
forall pass. HsPatSigType pass -> LHsType pass
hsPatSigType HsPatSigType GhcRn
sig)
; Name -> [CoreExpr] -> MetaM (Core (M RuleBndr))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
typedRuleVarName [CoreExpr
n', CoreExpr
ty'] }
repAnnD :: LAnnDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repAnnD :: LAnnDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repAnnD (L SrcSpanAnnA
loc (HsAnnotation XHsAnnotation GhcRn
_ AnnProvenance GhcRn
ann_prov (L SrcSpanAnnA
_ HsExpr GhcRn
exp)))
= do { Core AnnTarget
target <- AnnProvenance GhcRn -> MetaM (Core AnnTarget)
repAnnProv AnnProvenance GhcRn
ann_prov
; Core (M Exp)
exp' <- HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
exp
; Core (M Dec)
dec <- Core AnnTarget -> Core (M Exp) -> MetaM (Core (M Dec))
repPragAnn Core AnnTarget
target Core (M Exp)
exp'
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
dec) }
repAnnProv :: AnnProvenance GhcRn -> MetaM (Core TH.AnnTarget)
repAnnProv :: AnnProvenance GhcRn -> MetaM (Core AnnTarget)
repAnnProv (ValueAnnProvenance LIdP GhcRn
n)
= do {
MkC CoreExpr
n' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
n
; Name -> [CoreExpr] -> MetaM (Core AnnTarget)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
valueAnnotationName [ CoreExpr
n' ] }
repAnnProv (TypeAnnProvenance LIdP GhcRn
n)
= do { MkC CoreExpr
n' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
n
; Name -> [CoreExpr] -> MetaM (Core AnnTarget)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
typeAnnotationName [ CoreExpr
n' ] }
repAnnProv AnnProvenance GhcRn
ModuleAnnProvenance
= Name -> [CoreExpr] -> MetaM (Core AnnTarget)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
moduleAnnotationName []
repC :: LConDecl GhcRn -> MetaM (Core (M TH.Con))
repC :: LConDecl GhcRn -> MetaM (Core (M Con))
repC (L SrcSpanAnnA
_ (ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = LIdP GhcRn
con
, con_forall :: forall pass. ConDecl pass -> Bool
con_forall = Bool
False
, con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcRn)
Nothing
, con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details GhcRn
args }))
= GenLocated SrcSpanAnnN Name
-> HsConDeclH98Details GhcRn -> MetaM (Core (M Con))
repH98DataCon LIdP GhcRn
GenLocated SrcSpanAnnN Name
con HsConDeclH98Details GhcRn
args
repC (L SrcSpanAnnA
_ (ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = LIdP GhcRn
con
, con_forall :: forall pass. ConDecl pass -> Bool
con_forall = Bool
is_existential
, con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs = [LHsTyVarBndr Specificity GhcRn]
con_tvs
, con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcRn)
mcxt
, con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details GhcRn
args }))
= FreshOrReuse
-> [LHsTyVarBndr Specificity GhcRn]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con))
forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr Specificity GhcRn]
con_tvs ((Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con)))
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con))
forall a b. (a -> b) -> a -> b
$ \ Core [M (TyVarBndr Specificity)]
ex_bndrs ->
do { Core (M Con)
c' <- GenLocated SrcSpanAnnN Name
-> HsConDeclH98Details GhcRn -> MetaM (Core (M Con))
repH98DataCon LIdP GhcRn
GenLocated SrcSpanAnnN Name
con HsConDeclH98Details GhcRn
args
; Core (M Cxt)
ctxt' <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repMbContext Maybe (LHsContext GhcRn)
mcxt
; if Bool -> Bool
not Bool
is_existential Bool -> Bool -> Bool
&& Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)])
-> Bool
forall a. Maybe a -> Bool
isNothing Maybe (LHsContext GhcRn)
Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)])
mcxt
then Core (M Con) -> MetaM (Core (M Con))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Con)
c'
else Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forallCName ([Core [M (TyVarBndr Specificity)] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M (TyVarBndr Specificity)]
ex_bndrs, Core (M Cxt) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Cxt)
ctxt', Core (M Con) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Con)
c'])
}
repC (L SrcSpanAnnA
_ (ConDeclGADT { con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names = NonEmpty (LIdP GhcRn)
cons
, con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_bndrs = L SrcSpanAnnA
_ HsOuterSigTyVarBndrs GhcRn
outer_bndrs
, con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcRn)
mcxt
, con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails GhcRn
args
, con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty = XRec GhcRn (HsType GhcRn)
res_ty }))
| Bool
null_outer_imp_tvs Bool -> Bool -> Bool
&& Bool
null_outer_exp_tvs
, Maybe (LHsContext GhcRn)
Nothing <- Maybe (LHsContext GhcRn)
mcxt
= NonEmpty (GenLocated SrcSpanAnnN Name)
-> HsConDeclGADTDetails GhcRn
-> XRec GhcRn (HsType GhcRn)
-> MetaM (Core (M Con))
repGadtDataCons NonEmpty (LIdP GhcRn)
NonEmpty (GenLocated SrcSpanAnnN Name)
cons HsConDeclGADTDetails GhcRn
args XRec GhcRn (HsType GhcRn)
res_ty
| Bool
otherwise
= HsOuterSigTyVarBndrs GhcRn
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con))
forall a.
HsOuterSigTyVarBndrs GhcRn
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterSigTyVarBinds HsOuterSigTyVarBndrs GhcRn
outer_bndrs ((Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con)))
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con))
forall a b. (a -> b) -> a -> b
$ \ Core [M (TyVarBndr Specificity)]
outer_bndrs' ->
do { Core (M Con)
c' <- NonEmpty (GenLocated SrcSpanAnnN Name)
-> HsConDeclGADTDetails GhcRn
-> XRec GhcRn (HsType GhcRn)
-> MetaM (Core (M Con))
repGadtDataCons NonEmpty (LIdP GhcRn)
NonEmpty (GenLocated SrcSpanAnnN Name)
cons HsConDeclGADTDetails GhcRn
args XRec GhcRn (HsType GhcRn)
res_ty
; Core (M Cxt)
ctxt' <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repMbContext Maybe (LHsContext GhcRn)
mcxt
; if Bool
null_outer_exp_tvs Bool -> Bool -> Bool
&& Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)])
-> Bool
forall a. Maybe a -> Bool
isNothing Maybe (LHsContext GhcRn)
Maybe
(GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)])
mcxt
then Core (M Con) -> MetaM (Core (M Con))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Con)
c'
else Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forallCName ([Core [M (TyVarBndr Specificity)] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M (TyVarBndr Specificity)]
outer_bndrs', Core (M Cxt) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Cxt)
ctxt', Core (M Con) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Con)
c']) }
where
null_outer_imp_tvs :: Bool
null_outer_imp_tvs = HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterImplicit HsOuterSigTyVarBndrs GhcRn
outer_bndrs
null_outer_exp_tvs :: Bool
null_outer_exp_tvs = HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterExplicit HsOuterSigTyVarBndrs GhcRn
outer_bndrs
repMbContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M TH.Cxt))
repMbContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repMbContext Maybe (LHsContext GhcRn)
Nothing = [XRec GhcRn (HsType GhcRn)] -> MetaM (Core (M Cxt))
repContext []
repMbContext (Just (L SrcSpanAnnC
_ [GenLocated SrcSpanAnnA (HsType GhcRn)]
cxt)) = [XRec GhcRn (HsType GhcRn)] -> MetaM (Core (M Cxt))
repContext [XRec GhcRn (HsType GhcRn)]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
cxt
repSrcUnpackedness :: SrcUnpackedness -> MetaM (Core (M TH.SourceUnpackedness))
repSrcUnpackedness :: SrcUnpackedness -> MetaM (Core (M SourceUnpackedness))
repSrcUnpackedness SrcUnpackedness
SrcUnpack = Name -> [CoreExpr] -> MetaM (Core (M SourceUnpackedness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceUnpackName []
repSrcUnpackedness SrcUnpackedness
SrcNoUnpack = Name -> [CoreExpr] -> MetaM (Core (M SourceUnpackedness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceNoUnpackName []
repSrcUnpackedness SrcUnpackedness
NoSrcUnpack = Name -> [CoreExpr] -> MetaM (Core (M SourceUnpackedness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
noSourceUnpackednessName []
repSrcStrictness :: SrcStrictness -> MetaM (Core (M TH.SourceStrictness))
repSrcStrictness :: SrcStrictness -> MetaM (Core (M SourceStrictness))
repSrcStrictness SrcStrictness
SrcLazy = Name -> [CoreExpr] -> MetaM (Core (M SourceStrictness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceLazyName []
repSrcStrictness SrcStrictness
SrcStrict = Name -> [CoreExpr] -> MetaM (Core (M SourceStrictness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceStrictName []
repSrcStrictness SrcStrictness
NoSrcStrict = Name -> [CoreExpr] -> MetaM (Core (M SourceStrictness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
noSourceStrictnessName []
repBangTy :: LBangType GhcRn -> MetaM (Core (M TH.BangType))
repBangTy :: XRec GhcRn (HsType GhcRn) -> MetaM (Core (M BangType))
repBangTy XRec GhcRn (HsType GhcRn)
ty = do
MkC CoreExpr
u <- SrcUnpackedness -> MetaM (Core (M SourceUnpackedness))
repSrcUnpackedness SrcUnpackedness
su'
MkC CoreExpr
s <- SrcStrictness -> MetaM (Core (M SourceStrictness))
repSrcStrictness SrcStrictness
ss'
MkC CoreExpr
b <- Name -> [CoreExpr] -> MetaM (Core (M Any))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
bangName [CoreExpr
u, CoreExpr
s]
MkC CoreExpr
t <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
ty'
Name -> [CoreExpr] -> MetaM (Core (M BangType))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
bangTypeName [CoreExpr
b, CoreExpr
t]
where
(SrcUnpackedness
su', SrcStrictness
ss', GenLocated SrcSpanAnnA (HsType GhcRn)
ty') = case GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
ty of
HsBangTy XBangTy GhcRn
_ (HsSrcBang SourceText
_ SrcUnpackedness
su SrcStrictness
ss) XRec GhcRn (HsType GhcRn)
ty -> (SrcUnpackedness
su, SrcStrictness
ss, XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
ty)
HsType GhcRn
_ -> (SrcUnpackedness
NoSrcUnpack, SrcStrictness
NoSrcStrict, XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
ty)
repDerivs :: HsDeriving GhcRn -> MetaM (Core [M TH.DerivClause])
repDerivs :: HsDeriving GhcRn -> MetaM (Core [M DerivClause])
repDerivs HsDeriving GhcRn
clauses
= Name
-> (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcRn)
-> MetaM (Core (M DerivClause)))
-> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcRn)]
-> MetaM (Core [M DerivClause])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
derivClauseTyConName LHsDerivingClause GhcRn -> MetaM (Core (M DerivClause))
GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcRn)
-> MetaM (Core (M DerivClause))
repDerivClause HsDeriving GhcRn
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcRn)]
clauses
repDerivClause :: LHsDerivingClause GhcRn
-> MetaM (Core (M TH.DerivClause))
repDerivClause :: LHsDerivingClause GhcRn -> MetaM (Core (M DerivClause))
repDerivClause (L SrcAnn NoEpAnns
_ (HsDerivingClause
{ deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy = Maybe (LDerivStrategy GhcRn)
dcs
, deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_tys = LDerivClauseTys GhcRn
dct }))
= Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M DerivClause)))
-> MetaM (Core (M DerivClause))
forall a.
Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy Maybe (LDerivStrategy GhcRn)
dcs ((Core (Maybe (M DerivStrategy)) -> MetaM (Core (M DerivClause)))
-> MetaM (Core (M DerivClause)))
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M DerivClause)))
-> MetaM (Core (M DerivClause))
forall a b. (a -> b) -> a -> b
$ \(MkC CoreExpr
dcs') ->
do MkC CoreExpr
dct' <- LDerivClauseTys GhcRn -> MetaM (Core [M Type])
rep_deriv_clause_tys LDerivClauseTys GhcRn
dct
Name -> [CoreExpr] -> MetaM (Core (M DerivClause))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
derivClauseName [CoreExpr
dcs',CoreExpr
dct']
where
rep_deriv_clause_tys :: LDerivClauseTys GhcRn -> MetaM (Core [M TH.Type])
rep_deriv_clause_tys :: LDerivClauseTys GhcRn -> MetaM (Core [M Type])
rep_deriv_clause_tys (L SrcSpanAnnC
_ DerivClauseTys GhcRn
dct) = case DerivClauseTys GhcRn
dct of
DctSingle XDctSingle GhcRn
_ LHsSigType GhcRn
ty -> [LHsSigType GhcRn] -> MetaM (Core [M Type])
rep_deriv_tys [LHsSigType GhcRn
ty]
DctMulti XDctMulti GhcRn
_ [LHsSigType GhcRn]
tys -> [LHsSigType GhcRn] -> MetaM (Core [M Type])
rep_deriv_tys [LHsSigType GhcRn]
tys
rep_deriv_tys :: [LHsSigType GhcRn] -> MetaM (Core [M TH.Type])
rep_deriv_tys :: [LHsSigType GhcRn] -> MetaM (Core [M Type])
rep_deriv_tys = Name
-> (GenLocated SrcSpanAnnA (HsSigType GhcRn)
-> MetaM (Core (M Type)))
-> [GenLocated SrcSpanAnnA (HsSigType GhcRn)]
-> MetaM (Core [M Type])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
typeTyConName LHsSigType GhcRn -> MetaM (Core (M Type))
GenLocated SrcSpanAnnA (HsSigType GhcRn) -> MetaM (Core (M Type))
repHsSigType
rep_meth_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn
-> MetaM ([GenSymBind], [Core (M TH.Dec)])
rep_meth_sigs_binds :: [LSig GhcRn]
-> LHsBindsLR GhcRn GhcRn -> MetaM ([GenSymBind], [Core (M Dec)])
rep_meth_sigs_binds [LSig GhcRn]
sigs LHsBindsLR GhcRn GhcRn
binds
= do { let tvs :: [Name]
tvs = (GenLocated SrcSpanAnnA (Sig GhcRn) -> [Name])
-> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LSig GhcRn -> [Name]
GenLocated SrcSpanAnnA (Sig GhcRn) -> [Name]
get_scoped_tvs [LSig GhcRn]
[GenLocated SrcSpanAnnA (Sig GhcRn)]
sigs
; [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
tvs
; [(SrcSpan, Core (M Dec))]
sigs1 <- [GenSymBind]
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))])
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a b. (a -> b) -> a -> b
$ [LSig GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
rep_sigs [LSig GhcRn]
sigs
; [(SrcSpan, Core (M Dec))]
binds1 <- [GenSymBind]
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))])
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a b. (a -> b) -> a -> b
$ LHsBindsLR GhcRn GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_binds LHsBindsLR GhcRn GhcRn
binds
; ([GenSymBind], [Core (M Dec)])
-> MetaM ([GenSymBind], [Core (M Dec)])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss, [(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc ([(SrcSpan, Core (M Dec))]
sigs1 [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
binds1))) }
rep_sigs :: [LSig GhcRn] -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_sigs :: [LSig GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
rep_sigs = (GenLocated SrcSpanAnnA (Sig GhcRn)
-> MetaM [(SrcSpan, Core (M Dec))])
-> [GenLocated SrcSpanAnnA (Sig GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM LSig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
GenLocated SrcSpanAnnA (Sig GhcRn)
-> MetaM [(SrcSpan, Core (M Dec))]
rep_sig
rep_sig :: LSig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_sig :: LSig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_sig (L SrcSpanAnnA
loc (TypeSig XTypeSig GhcRn
_ [LIdP GhcRn]
nms LHsSigWcType GhcRn
ty))
= (GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnN Name] -> MetaM [(SrcSpan, Core (M Dec))]
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 (Name
-> SrcSpan
-> LHsSigWcType GhcRn
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_wc_ty_sig Name
sigDName (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) LHsSigWcType GhcRn
ty) [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
nms
rep_sig (L SrcSpanAnnA
loc (PatSynSig XPatSynSig GhcRn
_ [LIdP GhcRn]
nms LHsSigType GhcRn
ty))
= (GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnN Name] -> MetaM [(SrcSpan, Core (M Dec))]
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 (SrcSpan
-> LHsSigType GhcRn
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_patsyn_ty_sig (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) LHsSigType GhcRn
ty) [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
nms
rep_sig (L SrcSpanAnnA
loc (ClassOpSig XClassOpSig GhcRn
_ Bool
is_deflt [LIdP GhcRn]
nms LHsSigType GhcRn
ty))
| Bool
is_deflt = (GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnN Name] -> MetaM [(SrcSpan, Core (M Dec))]
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 (Name
-> SrcSpan
-> LHsSigType GhcRn
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
defaultSigDName (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) LHsSigType GhcRn
ty) [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
nms
| Bool
otherwise = (GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnN Name] -> MetaM [(SrcSpan, Core (M Dec))]
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 (Name
-> SrcSpan
-> LHsSigType GhcRn
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
sigDName (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) LHsSigType GhcRn
ty) [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
nms
rep_sig (L SrcSpanAnnA
loc (FixSig XFixSig GhcRn
_ FixitySig GhcRn
fix_sig)) = SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_fix_d (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) FixitySig GhcRn
fix_sig
rep_sig (L SrcSpanAnnA
loc (InlineSig XInlineSig GhcRn
_ LIdP GhcRn
nm InlinePragma
ispec))= GenLocated SrcSpanAnnN Name
-> InlinePragma -> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_inline LIdP GhcRn
GenLocated SrcSpanAnnN Name
nm InlinePragma
ispec (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
rep_sig (L SrcSpanAnnA
loc (SpecSig XSpecSig GhcRn
_ LIdP GhcRn
nm [LHsSigType GhcRn]
tys InlinePragma
ispec))
= (GenLocated SrcSpanAnnA (HsSigType GhcRn)
-> MetaM [(SrcSpan, Core (M Dec))])
-> [GenLocated SrcSpanAnnA (HsSigType GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM (\GenLocated SrcSpanAnnA (HsSigType GhcRn)
t -> GenLocated SrcSpanAnnN Name
-> LHsSigType GhcRn
-> InlinePragma
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_specialise LIdP GhcRn
GenLocated SrcSpanAnnN Name
nm LHsSigType GhcRn
GenLocated SrcSpanAnnA (HsSigType GhcRn)
t InlinePragma
ispec (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)) [LHsSigType GhcRn]
[GenLocated SrcSpanAnnA (HsSigType GhcRn)]
tys
rep_sig (L SrcSpanAnnA
loc (SpecInstSig XSpecInstSig GhcRn
_ LHsSigType GhcRn
ty)) = LHsSigType GhcRn -> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_specialiseInst LHsSigType GhcRn
ty (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
rep_sig (L SrcSpanAnnA
_ (MinimalSig {})) = ThRejectionReason -> MetaM [(SrcSpan, Core (M Dec))]
forall a. ThRejectionReason -> MetaM a
notHandled ThRejectionReason
ThMinimalPragmas
rep_sig (L SrcSpanAnnA
_ (SCCFunSig {})) = ThRejectionReason -> MetaM [(SrcSpan, Core (M Dec))]
forall a. ThRejectionReason -> MetaM a
notHandled ThRejectionReason
ThSCCPragmas
rep_sig (L SrcSpanAnnA
loc (CompleteMatchSig XCompleteMatchSig GhcRn
_ XRec GhcRn [LIdP GhcRn]
cls Maybe (LIdP GhcRn)
mty))
= Located [GenLocated SrcSpanAnnN Name]
-> Maybe (GenLocated SrcSpanAnnN Name)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_complete_sig XRec GhcRn [LIdP GhcRn]
Located [GenLocated SrcSpanAnnN Name]
cls Maybe (LIdP GhcRn)
Maybe (GenLocated SrcSpanAnnN Name)
mty (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)
rep_sig d :: LSig GhcRn
d@(L SrcSpanAnnA
_ (XSig {})) = String -> SDoc -> MetaM [(SrcSpan, Core (M Dec))]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rep_sig IdSig" (GenLocated SrcSpanAnnA (Sig GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LSig GhcRn
GenLocated SrcSpanAnnA (Sig GhcRn)
d)
rep_ty_sig_tvs :: [LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M TH.TyVarBndrSpec])
rep_ty_sig_tvs :: [LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity GhcRn]
explicit_tvs
= Name
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn)
-> MetaM (Core (M (TyVarBndr Specificity))))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn)]
-> MetaM (Core [M (TyVarBndr Specificity)])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
tyVarBndrSpecTyConName LHsTyVarBndr Specificity GhcRn
-> MetaM (Core (M (TyVarBndr Specificity)))
GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn)
-> MetaM (Core (M (TyVarBndr Specificity)))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr
[LHsTyVarBndr Specificity GhcRn]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn)]
explicit_tvs
rep_ty_sig_outer_tvs :: HsOuterSigTyVarBndrs GhcRn
-> MetaM (Core [M TH.TyVarBndrSpec])
rep_ty_sig_outer_tvs :: HsOuterSigTyVarBndrs GhcRn
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_outer_tvs (HsOuterImplicit{}) =
Name
-> [Core (M (TyVarBndr Specificity))]
-> MetaM (Core [M (TyVarBndr Specificity)])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
tyVarBndrSpecTyConName []
rep_ty_sig_outer_tvs (HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
explicit_tvs}) =
[LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
[LHsTyVarBndr Specificity GhcRn]
explicit_tvs
rep_ty_sig :: Name -> SrcSpan -> LHsSigType GhcRn -> LocatedN Name
-> MetaM (SrcSpan, Core (M TH.Dec))
rep_ty_sig :: Name
-> SrcSpan
-> LHsSigType GhcRn
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
mk_sig SrcSpan
loc LHsSigType GhcRn
sig_ty GenLocated SrcSpanAnnN Name
nm
= do { Core Name
nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
; Core (M Type)
ty1 <- LHsSigType GhcRn -> MetaM (Core (M Type))
rep_ty_sig' LHsSigType GhcRn
sig_ty
; Core (M Dec)
sig <- Name -> Core Name -> Core (M Type) -> MetaM (Core (M Dec))
repProto Name
mk_sig Core Name
nm1 Core (M Type)
ty1
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
sig) }
rep_ty_sig' :: LHsSigType GhcRn
-> MetaM (Core (M TH.Type))
rep_ty_sig' :: LHsSigType GhcRn -> MetaM (Core (M Type))
rep_ty_sig' (L SrcSpanAnnA
_ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcRn
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = XRec GhcRn (HsType GhcRn)
body}))
| (Maybe (LHsContext GhcRn)
ctxt, XRec GhcRn (HsType GhcRn)
tau) <- XRec GhcRn (HsType GhcRn)
-> (Maybe (LHsContext GhcRn), XRec GhcRn (HsType GhcRn))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy XRec GhcRn (HsType GhcRn)
body
= do { Core [M (TyVarBndr Specificity)]
th_explicit_tvs <- HsOuterSigTyVarBndrs GhcRn
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_outer_tvs HsOuterSigTyVarBndrs GhcRn
outer_bndrs
; Core (M Cxt)
th_ctxt <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
ctxt
; Core (M Type)
th_tau <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
tau
; if HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterExplicit HsOuterSigTyVarBndrs GhcRn
outer_bndrs Bool -> Bool -> Bool
&& [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe (LHsContext GhcRn) -> [XRec GhcRn (HsType GhcRn)]
forall (p :: Pass).
Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
fromMaybeContext Maybe (LHsContext GhcRn)
ctxt)
then Core (M Type) -> MetaM (Core (M Type))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Type)
th_tau
else Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
th_explicit_tvs Core (M Cxt)
th_ctxt Core (M Type)
th_tau }
rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> LocatedN Name
-> MetaM (SrcSpan, Core (M TH.Dec))
rep_patsyn_ty_sig :: SrcSpan
-> LHsSigType GhcRn
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_patsyn_ty_sig SrcSpan
loc LHsSigType GhcRn
sig_ty GenLocated SrcSpanAnnN Name
nm
| ([LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass 'Renamed))]
univs, Maybe (LHsContext GhcRn)
reqs, [LHsTyVarBndr Specificity GhcRn]
exis, Maybe (LHsContext GhcRn)
provs, XRec GhcRn (HsType GhcRn)
ty) <- LHsSigType GhcRn
-> ([LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass 'Renamed))],
Maybe (LHsContext GhcRn), [LHsTyVarBndr Specificity GhcRn],
Maybe (LHsContext GhcRn), XRec GhcRn (HsType GhcRn))
forall (p :: Pass).
LHsSigType (GhcPass p)
-> ([LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))],
Maybe (LHsContext (GhcPass p)),
[LHsTyVarBndr Specificity (GhcPass p)],
Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
splitLHsPatSynTy LHsSigType GhcRn
sig_ty
= do { Core Name
nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
; Core [M (TyVarBndr Specificity)]
th_univs <- [LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass 'Renamed))]
[LHsTyVarBndr Specificity GhcRn]
univs
; Core [M (TyVarBndr Specificity)]
th_exis <- [LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity GhcRn]
exis
; Core (M Cxt)
th_reqs <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
reqs
; Core (M Cxt)
th_provs <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
provs
; Core (M Type)
th_ty <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ty
; Core (M Type)
ty1 <- Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
th_univs Core (M Cxt)
th_reqs (Core (M Type) -> MetaM (Core (M Type)))
-> MetaM (Core (M Type)) -> MetaM (Core (M Type))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
th_exis Core (M Cxt)
th_provs Core (M Type)
th_ty
; Core (M Dec)
sig <- Name -> Core Name -> Core (M Type) -> MetaM (Core (M Dec))
repProto Name
patSynSigDName Core Name
nm1 Core (M Type)
ty1
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
sig) }
rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> LocatedN Name
-> MetaM (SrcSpan, Core (M TH.Dec))
rep_wc_ty_sig :: Name
-> SrcSpan
-> LHsSigWcType GhcRn
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_wc_ty_sig Name
mk_sig SrcSpan
loc LHsSigWcType GhcRn
sig_ty GenLocated SrcSpanAnnN Name
nm
= Name
-> SrcSpan
-> LHsSigType GhcRn
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
mk_sig SrcSpan
loc (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> GenLocated SrcSpanAnnA (HsSigType GhcRn)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsSigWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
sig_ty) GenLocated SrcSpanAnnN Name
nm
rep_inline :: LocatedN Name
-> InlinePragma
-> SrcSpan
-> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_inline :: GenLocated SrcSpanAnnN Name
-> InlinePragma -> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_inline GenLocated SrcSpanAnnN Name
nm InlinePragma
ispec SrcSpan
loc
| Opaque {} <- InlinePragma -> InlineSpec
inl_inline InlinePragma
ispec
= do { Core Name
nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
; Core (M Dec)
opq <- Core Name -> MetaM (Core (M Dec))
repPragOpaque Core Name
nm1
; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core (M Dec)
opq)]
}
rep_inline GenLocated SrcSpanAnnN Name
nm InlinePragma
ispec SrcSpan
loc
= do { Core Name
nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
; Core Inline
inline <- InlineSpec -> MetaM (Core Inline)
repInline (InlineSpec -> MetaM (Core Inline))
-> InlineSpec -> MetaM (Core Inline)
forall a b. (a -> b) -> a -> b
$ InlinePragma -> InlineSpec
inl_inline InlinePragma
ispec
; Core RuleMatch
rm <- RuleMatchInfo -> MetaM (Core RuleMatch)
repRuleMatch (RuleMatchInfo -> MetaM (Core RuleMatch))
-> RuleMatchInfo -> MetaM (Core RuleMatch)
forall a b. (a -> b) -> a -> b
$ InlinePragma -> RuleMatchInfo
inl_rule InlinePragma
ispec
; Core Phases
phases <- Activation -> MetaM (Core Phases)
repPhases (Activation -> MetaM (Core Phases))
-> Activation -> MetaM (Core Phases)
forall a b. (a -> b) -> a -> b
$ InlinePragma -> Activation
inl_act InlinePragma
ispec
; Core (M Dec)
pragma <- Core Name
-> Core Inline
-> Core RuleMatch
-> Core Phases
-> MetaM (Core (M Dec))
repPragInl Core Name
nm1 Core Inline
inline Core RuleMatch
rm Core Phases
phases
; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core (M Dec)
pragma)]
}
rep_specialise :: LocatedN Name -> LHsSigType GhcRn -> InlinePragma
-> SrcSpan
-> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_specialise :: GenLocated SrcSpanAnnN Name
-> LHsSigType GhcRn
-> InlinePragma
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_specialise GenLocated SrcSpanAnnN Name
nm LHsSigType GhcRn
ty InlinePragma
ispec SrcSpan
loc
= do { Core Name
nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
; Core (M Type)
ty1 <- LHsSigType GhcRn -> MetaM (Core (M Type))
repHsSigType LHsSigType GhcRn
ty
; Core Phases
phases <- Activation -> MetaM (Core Phases)
repPhases (Activation -> MetaM (Core Phases))
-> Activation -> MetaM (Core Phases)
forall a b. (a -> b) -> a -> b
$ InlinePragma -> Activation
inl_act InlinePragma
ispec
; let inline :: InlineSpec
inline = InlinePragma -> InlineSpec
inl_inline InlinePragma
ispec
; Core (M Dec)
pragma <- if InlineSpec -> Bool
noUserInlineSpec InlineSpec
inline
then
Core Name -> Core (M Type) -> Core Phases -> MetaM (Core (M Dec))
repPragSpec Core Name
nm1 Core (M Type)
ty1 Core Phases
phases
else
do { Core Inline
inline1 <- InlineSpec -> MetaM (Core Inline)
repInline InlineSpec
inline
; Core Name
-> Core (M Type)
-> Core Inline
-> Core Phases
-> MetaM (Core (M Dec))
repPragSpecInl Core Name
nm1 Core (M Type)
ty1 Core Inline
inline1 Core Phases
phases }
; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core (M Dec)
pragma)]
}
rep_specialiseInst :: LHsSigType GhcRn -> SrcSpan
-> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_specialiseInst :: LHsSigType GhcRn -> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_specialiseInst LHsSigType GhcRn
ty SrcSpan
loc
= do { Core (M Type)
ty1 <- LHsSigType GhcRn -> MetaM (Core (M Type))
repHsSigType LHsSigType GhcRn
ty
; Core (M Dec)
pragma <- Core (M Type) -> MetaM (Core (M Dec))
repPragSpecInst Core (M Type)
ty1
; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core (M Dec)
pragma)] }
repInline :: InlineSpec -> MetaM (Core TH.Inline)
repInline :: InlineSpec -> MetaM (Core Inline)
repInline (NoInline SourceText
_ ) = Name -> MetaM (Core Inline)
forall a. Name -> MetaM (Core a)
dataCon Name
noInlineDataConName
repInline (Opaque SourceText
_ ) = String -> MetaM (Core Inline)
forall a. HasCallStack => String -> a
panic String
"repInline: Opaque"
repInline (Inline SourceText
_ ) = Name -> MetaM (Core Inline)
forall a. Name -> MetaM (Core a)
dataCon Name
inlineDataConName
repInline (Inlinable SourceText
_ ) = Name -> MetaM (Core Inline)
forall a. Name -> MetaM (Core a)
dataCon Name
inlinableDataConName
repInline InlineSpec
NoUserInlinePrag = ThRejectionReason -> MetaM (Core Inline)
forall a. ThRejectionReason -> MetaM a
notHandled ThRejectionReason
ThNoUserInline
repRuleMatch :: RuleMatchInfo -> MetaM (Core TH.RuleMatch)
repRuleMatch :: RuleMatchInfo -> MetaM (Core RuleMatch)
repRuleMatch RuleMatchInfo
ConLike = Name -> MetaM (Core RuleMatch)
forall a. Name -> MetaM (Core a)
dataCon Name
conLikeDataConName
repRuleMatch RuleMatchInfo
FunLike = Name -> MetaM (Core RuleMatch)
forall a. Name -> MetaM (Core a)
dataCon Name
funLikeDataConName
repPhases :: Activation -> MetaM (Core TH.Phases)
repPhases :: Activation -> MetaM (Core Phases)
repPhases (ActiveBefore SourceText
_ Int
i) = do { MkC CoreExpr
arg <- Int -> MetaM (Core Int)
coreIntLit Int
i
; Name -> [CoreExpr] -> MetaM (Core Phases)
forall a. Name -> [CoreExpr] -> MetaM (Core a)
dataCon' Name
beforePhaseDataConName [CoreExpr
arg] }
repPhases (ActiveAfter SourceText
_ Int
i) = do { MkC CoreExpr
arg <- Int -> MetaM (Core Int)
coreIntLit Int
i
; Name -> [CoreExpr] -> MetaM (Core Phases)
forall a. Name -> [CoreExpr] -> MetaM (Core a)
dataCon' Name
fromPhaseDataConName [CoreExpr
arg] }
repPhases Activation
_ = Name -> MetaM (Core Phases)
forall a. Name -> MetaM (Core a)
dataCon Name
allPhasesDataConName
rep_complete_sig :: Located [LocatedN Name]
-> Maybe (LocatedN Name)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_complete_sig :: Located [GenLocated SrcSpanAnnN Name]
-> Maybe (GenLocated SrcSpanAnnN Name)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_complete_sig (L SrcSpan
_ [GenLocated SrcSpanAnnN Name]
cls) Maybe (GenLocated SrcSpanAnnN Name)
mty SrcSpan
loc
= do { Core (Maybe Name)
mty' <- Name
-> (GenLocated SrcSpanAnnN Name -> MetaM (Core Name))
-> Maybe (GenLocated SrcSpanAnnN Name)
-> MetaM (Core (Maybe Name))
forall a b.
Name -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
repMaybe Name
nameTyConName GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc Maybe (GenLocated SrcSpanAnnN Name)
mty
; Core [Name]
cls' <- Name
-> (GenLocated SrcSpanAnnN Name -> MetaM (Core Name))
-> [GenLocated SrcSpanAnnN Name]
-> MetaM (Core [Name])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
nameTyConName GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc [GenLocated SrcSpanAnnN Name]
cls
; Core (M Dec)
sig <- Core [Name] -> Core (Maybe Name) -> MetaM (Core (M Dec))
repPragComplete Core [Name]
cls' Core (Maybe Name)
mty'
; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core (M Dec)
sig)] }
class RepTV flag flag' | flag -> flag' where
tyVarBndrName :: Name
repPlainTV :: Core TH.Name -> flag -> MetaM (Core (M (TH.TyVarBndr flag')))
repKindedTV :: Core TH.Name -> flag -> Core (M TH.Kind)
-> MetaM (Core (M (TH.TyVarBndr flag')))
instance RepTV () () where
tyVarBndrName :: Name
tyVarBndrName = Name
tyVarBndrUnitTyConName
repPlainTV :: Core Name -> () -> MetaM (Core (M (TyVarBndr ())))
repPlainTV (MkC CoreExpr
nm) () = Name -> [CoreExpr] -> MetaM (Core (M (TyVarBndr ())))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
plainTVName [CoreExpr
nm]
repKindedTV :: Core Name -> () -> Core (M Type) -> MetaM (Core (M (TyVarBndr ())))
repKindedTV (MkC CoreExpr
nm) () (MkC CoreExpr
ki) = Name -> [CoreExpr] -> MetaM (Core (M (TyVarBndr ())))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
kindedTVName [CoreExpr
nm, CoreExpr
ki]
instance RepTV Specificity TH.Specificity where
tyVarBndrName :: Name
tyVarBndrName = Name
tyVarBndrSpecTyConName
repPlainTV :: Core Name
-> Specificity -> MetaM (Core (M (TyVarBndr Specificity)))
repPlainTV (MkC CoreExpr
nm) Specificity
spec = do { (MkC CoreExpr
spec') <- Specificity -> MetaM (Core Specificity)
rep_flag Specificity
spec
; Name -> [CoreExpr] -> MetaM (Core (M (TyVarBndr Specificity)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
plainInvisTVName [CoreExpr
nm, CoreExpr
spec'] }
repKindedTV :: Core Name
-> Specificity
-> Core (M Type)
-> MetaM (Core (M (TyVarBndr Specificity)))
repKindedTV (MkC CoreExpr
nm) Specificity
spec (MkC CoreExpr
ki) = do { (MkC CoreExpr
spec') <- Specificity -> MetaM (Core Specificity)
rep_flag Specificity
spec
; Name -> [CoreExpr] -> MetaM (Core (M (TyVarBndr Specificity)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
kindedInvisTVName [CoreExpr
nm, CoreExpr
spec', CoreExpr
ki] }
rep_flag :: Specificity -> MetaM (Core TH.Specificity)
rep_flag :: Specificity -> MetaM (Core Specificity)
rep_flag Specificity
SpecifiedSpec = Name -> [CoreExpr] -> MetaM (Core Specificity)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
specifiedSpecName []
rep_flag Specificity
InferredSpec = Name -> [CoreExpr] -> MetaM (Core Specificity)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
inferredSpecName []
addHsOuterFamEqnTyVarBinds ::
HsOuterFamEqnTyVarBndrs GhcRn
-> (Core (Maybe [M TH.TyVarBndrUnit]) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterFamEqnTyVarBinds :: forall a.
HsOuterFamEqnTyVarBndrs GhcRn
-> (Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterFamEqnTyVarBinds HsOuterFamEqnTyVarBndrs GhcRn
outer_bndrs Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a))
thing_inside = do
Type
elt_ty <- Name -> MetaM Type
wrapName Name
tyVarBndrUnitTyConName
case HsOuterFamEqnTyVarBndrs GhcRn
outer_bndrs of
HsOuterImplicit{hso_ximplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
hso_ximplicit = XHsOuterImplicit GhcRn
imp_tvs} ->
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a.
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
ReuseBoundNames [Name]
XHsOuterImplicit GhcRn
imp_tvs (MetaM (Core (M a)) -> MetaM (Core (M a)))
-> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$
Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a))
thing_inside (Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a)))
-> Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$ Type -> Core (Maybe [M (TyVarBndr ())])
forall a. Type -> Core (Maybe [a])
coreNothingList Type
elt_ty
HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr () (NoGhcTc GhcRn)]
exp_bndrs} ->
FreshOrReuse
-> [LHsTyVarBndr () GhcRn]
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr () (NoGhcTc GhcRn)]
[LHsTyVarBndr () GhcRn]
exp_bndrs ((Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
th_exp_bndrs ->
Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a))
thing_inside (Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a)))
-> Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$ Type -> Core [M (TyVarBndr ())] -> Core (Maybe [M (TyVarBndr ())])
forall a. Type -> Core [a] -> Core (Maybe [a])
coreJustList Type
elt_ty Core [M (TyVarBndr ())]
th_exp_bndrs
addHsOuterSigTyVarBinds ::
HsOuterSigTyVarBndrs GhcRn
-> (Core [M TH.TyVarBndrSpec] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterSigTyVarBinds :: forall a.
HsOuterSigTyVarBndrs GhcRn
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterSigTyVarBinds HsOuterSigTyVarBndrs GhcRn
outer_bndrs Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a))
thing_inside = case HsOuterSigTyVarBndrs GhcRn
outer_bndrs of
HsOuterImplicit{hso_ximplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
hso_ximplicit = XHsOuterImplicit GhcRn
imp_tvs} ->
do Core [M (TyVarBndr Specificity)]
th_nil <- Name
-> [Core (M (TyVarBndr Specificity))]
-> MetaM (Core [M (TyVarBndr Specificity)])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
tyVarBndrSpecTyConName []
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a.
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
FreshNamesOnly [Name]
XHsOuterImplicit GhcRn
imp_tvs (MetaM (Core (M a)) -> MetaM (Core (M a)))
-> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$ Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a))
thing_inside Core [M (TyVarBndr Specificity)]
th_nil
HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
exp_bndrs} ->
FreshOrReuse
-> [LHsTyVarBndr Specificity GhcRn]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
[LHsTyVarBndr Specificity GhcRn]
exp_bndrs Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a))
thing_inside
nullOuterImplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterImplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterImplicit (HsOuterImplicit{hso_ximplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
hso_ximplicit = XHsOuterImplicit GhcRn
imp_tvs}) = [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
XHsOuterImplicit GhcRn
imp_tvs
nullOuterImplicit (HsOuterExplicit{}) = Bool
True
nullOuterExplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterExplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterExplicit (HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
exp_bndrs}) = [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn)]
exp_bndrs
nullOuterExplicit (HsOuterImplicit{}) = Bool
True
data FreshOrReuse
= FreshNamesOnly
| ReuseBoundNames
mkGenSyms' :: FreshOrReuse -> [Name] -> MetaM [GenSymBind]
mkGenSyms' :: FreshOrReuse -> [Name] -> MetaM [GenSymBind]
mkGenSyms' FreshOrReuse
FreshNamesOnly [Name]
names = [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
names
mkGenSyms' FreshOrReuse
ReuseBoundNames [Name]
names =
do { DsMetaEnv
env <- DsM DsMetaEnv -> ReaderT MetaWrappers DsM DsMetaEnv
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift DsM DsMetaEnv
dsGetMetaEnv
; [Name] -> MetaM [GenSymBind]
mkGenSyms ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filterOut (Name -> DsMetaEnv -> Bool
forall a. Name -> NameEnv a -> Bool
`elemNameEnv` DsMetaEnv
env) [Name]
names) }
addSimpleTyVarBinds :: FreshOrReuse
-> [Name]
-> MetaM (Core (M a))
-> MetaM (Core (M a))
addSimpleTyVarBinds :: forall a.
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
fresh_or_reuse [Name]
names MetaM (Core (M a))
thing_inside
= do { [GenSymBind]
fresh_names <- FreshOrReuse -> [Name] -> MetaM [GenSymBind]
mkGenSyms' FreshOrReuse
fresh_or_reuse [Name]
names
; Core (M a)
term <- [GenSymBind] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
fresh_names MetaM (Core (M a))
thing_inside
; [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
fresh_names Core (M a)
term }
addHsTyVarBinds :: forall flag flag' a. RepTV flag flag'
=> FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [(M (TH.TyVarBndr flag'))] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds :: forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
fresh_or_reuse [LHsTyVarBndr flag GhcRn]
exp_tvs Core [M (TyVarBndr flag')] -> MetaM (Core (M a))
thing_inside
= do { [GenSymBind]
fresh_exp_names <- FreshOrReuse -> [Name] -> MetaM [GenSymBind]
mkGenSyms' FreshOrReuse
fresh_or_reuse ([LHsTyVarBndr flag GhcRn] -> [IdP GhcRn]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr flag GhcRn]
exp_tvs)
; Core (M a)
term <- [GenSymBind] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
fresh_exp_names (MetaM (Core (M a)) -> MetaM (Core (M a)))
-> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$
do { Core [M (TyVarBndr flag')]
kbs <- Name
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
-> MetaM (Core (M (TyVarBndr flag'))))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
-> MetaM (Core [M (TyVarBndr flag')])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM (forall flag flag'. RepTV flag flag' => Name
tyVarBndrName @flag @flag') LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TyVarBndr flag')))
GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)
-> MetaM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr
[LHsTyVarBndr flag GhcRn]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcRn)]
exp_tvs
; Core [M (TyVarBndr flag')] -> MetaM (Core (M a))
thing_inside Core [M (TyVarBndr flag')]
kbs }
; [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
fresh_exp_names Core (M a)
term }
addQTyVarBinds :: FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [(M (TH.TyVarBndr ()))] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addQTyVarBinds :: forall a.
FreshOrReuse
-> LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addQTyVarBinds FreshOrReuse
fresh_or_reuse LHsQTyVars GhcRn
qtvs Core [M (TyVarBndr ())] -> MetaM (Core (M a))
thing_inside =
let HsQTvs { hsq_ext :: forall pass. LHsQTyVars pass -> XHsQTvs pass
hsq_ext = XHsQTvs GhcRn
imp_tvs
, hsq_explicit :: forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit = [LHsTyVarBndr () GhcRn]
exp_tvs }
= LHsQTyVars GhcRn
qtvs
in FreshOrReuse
-> [LHsTyVarBndr () GhcRn]
-> [Name]
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> [Name]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyVarBinds FreshOrReuse
fresh_or_reuse [LHsTyVarBndr () GhcRn]
exp_tvs [Name]
XHsQTvs GhcRn
imp_tvs Core [M (TyVarBndr ())] -> MetaM (Core (M a))
thing_inside
addTyVarBinds :: RepTV flag flag'
=> FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> [Name]
-> (Core [(M (TH.TyVarBndr flag'))] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyVarBinds :: forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> [Name]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyVarBinds FreshOrReuse
fresh_or_reuse [LHsTyVarBndr flag GhcRn]
exp_tvs [Name]
imp_tvs Core [M (TyVarBndr flag')] -> MetaM (Core (M a))
thing_inside
= FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a.
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
fresh_or_reuse [Name]
imp_tvs (MetaM (Core (M a)) -> MetaM (Core (M a)))
-> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
fresh_or_reuse [LHsTyVarBndr flag GhcRn]
exp_tvs ((Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a)))
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$
Core [M (TyVarBndr flag')] -> MetaM (Core (M a))
thing_inside
repTyVarBndr :: RepTV flag flag'
=> LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TH.TyVarBndr flag')))
repTyVarBndr :: forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr (L SrcSpanAnnA
_ (UserTyVar XUserTyVar GhcRn
_ flag
fl (L SrcSpanAnnN
_ Name
nm)) )
= do { Core Name
nm' <- Name -> MetaM (Core Name)
lookupBinder Name
nm
; Core Name -> flag -> MetaM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
Core Name -> flag -> MetaM (Core (M (TyVarBndr flag')))
repPlainTV Core Name
nm' flag
fl }
repTyVarBndr (L SrcSpanAnnA
_ (KindedTyVar XKindedTyVar GhcRn
_ flag
fl (L SrcSpanAnnN
_ Name
nm) XRec GhcRn (HsType GhcRn)
ki))
= do { Core Name
nm' <- Name -> MetaM (Core Name)
lookupBinder Name
nm
; Core (M Type)
ki' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ki
; Core Name
-> flag -> Core (M Type) -> MetaM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
Core Name
-> flag -> Core (M Type) -> MetaM (Core (M (TyVarBndr flag')))
repKindedTV Core Name
nm' flag
fl Core (M Type)
ki' }
repLContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M TH.Cxt))
repLContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
Nothing = [XRec GhcRn (HsType GhcRn)] -> MetaM (Core (M Cxt))
repContext []
repLContext (Just LHsContext GhcRn
ctxt) = [XRec GhcRn (HsType GhcRn)] -> MetaM (Core (M Cxt))
repContext (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall l e. GenLocated l e -> e
unLoc LHsContext GhcRn
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
ctxt)
repContext :: HsContext GhcRn -> MetaM (Core (M TH.Cxt))
repContext :: [XRec GhcRn (HsType GhcRn)] -> MetaM (Core (M Cxt))
repContext [XRec GhcRn (HsType GhcRn)]
ctxt = do Core [M Type]
preds <- Name
-> (GenLocated SrcSpanAnnA (HsType GhcRn) -> MetaM (Core (M Type)))
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> MetaM (Core [M Type])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
typeTyConName XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
GenLocated SrcSpanAnnA (HsType GhcRn) -> MetaM (Core (M Type))
repLTy [XRec GhcRn (HsType GhcRn)]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
ctxt
Core [M Type] -> MetaM (Core (M Cxt))
repCtxt Core [M Type]
preds
repHsSigType :: LHsSigType GhcRn -> MetaM (Core (M TH.Type))
repHsSigType :: LHsSigType GhcRn -> MetaM (Core (M Type))
repHsSigType (L SrcSpanAnnA
_ (HsSig { sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs GhcRn
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = XRec GhcRn (HsType GhcRn)
body }))
| (Maybe (LHsContext GhcRn)
ctxt, XRec GhcRn (HsType GhcRn)
tau) <- XRec GhcRn (HsType GhcRn)
-> (Maybe (LHsContext GhcRn), XRec GhcRn (HsType GhcRn))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy XRec GhcRn (HsType GhcRn)
body
= HsOuterSigTyVarBndrs GhcRn
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall a.
HsOuterSigTyVarBndrs GhcRn
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterSigTyVarBinds HsOuterSigTyVarBndrs GhcRn
outer_bndrs ((Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type)))
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall a b. (a -> b) -> a -> b
$ \ Core [M (TyVarBndr Specificity)]
th_outer_bndrs ->
do { Core (M Cxt)
th_ctxt <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
ctxt
; Core (M Type)
th_tau <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
tau
; if HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterExplicit HsOuterSigTyVarBndrs GhcRn
outer_bndrs Bool -> Bool -> Bool
&& [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe (LHsContext GhcRn) -> [XRec GhcRn (HsType GhcRn)]
forall (p :: Pass).
Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
fromMaybeContext Maybe (LHsContext GhcRn)
ctxt)
then Core (M Type) -> MetaM (Core (M Type))
forall a. a -> ReaderT MetaWrappers DsM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Core (M Type)
th_tau
else Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
th_outer_bndrs Core (M Cxt)
th_ctxt Core (M Type)
th_tau }
repLTys :: [LHsType GhcRn] -> MetaM [Core (M TH.Type)]
repLTys :: [XRec GhcRn (HsType GhcRn)] -> MetaM [Core (M Type)]
repLTys [XRec GhcRn (HsType GhcRn)]
tys = (GenLocated SrcSpanAnnA (HsType GhcRn) -> MetaM (Core (M Type)))
-> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> MetaM [Core (M Type)]
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 XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
GenLocated SrcSpanAnnA (HsType GhcRn) -> MetaM (Core (M Type))
repLTy [XRec GhcRn (HsType GhcRn)]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
tys
repLTy :: LHsType GhcRn -> MetaM (Core (M TH.Type))
repLTy :: XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ty = HsType GhcRn -> MetaM (Core (M Type))
repTy (GenLocated SrcSpanAnnA (HsType GhcRn) -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
ty)
repForallT :: HsType GhcRn -> MetaM (Core (M TH.Type))
repForallT :: HsType GhcRn -> MetaM (Core (M Type))
repForallT HsType GhcRn
ty
| ([LHsTyVarBndr Specificity GhcRn]
tvs, Maybe (LHsContext GhcRn)
ctxt, XRec GhcRn (HsType GhcRn)
tau) <- XRec GhcRn (HsType GhcRn)
-> ([LHsTyVarBndr Specificity GhcRn], Maybe (LHsContext GhcRn),
XRec GhcRn (HsType GhcRn))
forall (p :: Pass).
LHsType (GhcPass p)
-> ([LHsTyVarBndr Specificity (GhcPass p)],
Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
splitLHsSigmaTyInvis (HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a an. a -> LocatedAn an a
noLocA HsType GhcRn
ty)
= FreshOrReuse
-> [LHsTyVarBndr Specificity GhcRn]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr Specificity GhcRn]
tvs ((Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type)))
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr Specificity)]
bndrs ->
do { Core (M Cxt)
ctxt1 <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext GhcRn)
ctxt
; Core (M Type)
tau1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
tau
; Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
bndrs Core (M Cxt)
ctxt1 Core (M Type)
tau1
}
repTy :: HsType GhcRn -> MetaM (Core (M TH.Type))
repTy :: HsType GhcRn -> MetaM (Core (M Type))
repTy ty :: HsType GhcRn
ty@(HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllTelescope GhcRn
tele, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = XRec GhcRn (HsType GhcRn)
body }) =
case HsForAllTelescope GhcRn
tele of
HsForAllInvis{} -> HsType GhcRn -> MetaM (Core (M Type))
repForallT HsType GhcRn
ty
HsForAllVis { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () GhcRn]
tvs } ->
FreshOrReuse
-> [LHsTyVarBndr () GhcRn]
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall flag flag' a.
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr () GhcRn]
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
do Core (M Type)
body1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
body
Core [M (TyVarBndr ())] -> Core (M Type) -> MetaM (Core (M Type))
repTForallVis Core [M (TyVarBndr ())]
bndrs Core (M Type)
body1
repTy ty :: HsType GhcRn
ty@(HsQualTy {}) = HsType GhcRn -> MetaM (Core (M Type))
repForallT HsType GhcRn
ty
repTy (HsTyVar XTyVar GhcRn
_ PromotionFlag
_ (L SrcSpanAnnN
_ Name
n))
| Name
n Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
liftedTypeKindTyConKey = MetaM (Core (M Type))
repTStar
| Name
n Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
constraintKindTyConKey = MetaM (Core (M Type))
repTConstraint
| Name
n Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
unrestrictedFunTyConKey = MetaM (Core (M Type))
repArrowTyCon
| Name
n Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
fUNTyConKey = MetaM (Core (M Type))
repMulArrowTyCon
| OccName -> Bool
isTvOcc OccName
occ = do Core Name
tv1 <- Name -> MetaM (Core Name)
lookupOcc Name
n
Core Name -> MetaM (Core (M Type))
repTvar Core Name
tv1
| OccName -> Bool
isDataOcc OccName
occ = do Core Name
tc1 <- Name -> MetaM (Core Name)
lookupOcc Name
n
Core Name -> MetaM (Core (M Type))
repPromotedDataCon Core Name
tc1
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
eqTyConName = MetaM (Core (M Type))
repTequality
| Bool
otherwise = do Core Name
tc1 <- Name -> MetaM (Core Name)
lookupOcc Name
n
Core Name -> MetaM (Core (M Type))
repNamedTyCon Core Name
tc1
where
occ :: OccName
occ = Name -> OccName
nameOccName Name
n
repTy (HsAppTy XAppTy GhcRn
_ XRec GhcRn (HsType GhcRn)
f XRec GhcRn (HsType GhcRn)
a) = do
Core (M Type)
f1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
f
Core (M Type)
a1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
a
Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
f1 Core (M Type)
a1
repTy (HsAppKindTy XAppKindTy GhcRn
_ XRec GhcRn (HsType GhcRn)
ty XRec GhcRn (HsType GhcRn)
ki) = do
Core (M Type)
ty1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ty
Core (M Type)
ki1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
ki
Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTappKind Core (M Type)
ty1 Core (M Type)
ki1
repTy (HsFunTy XFunTy GhcRn
_ HsArrow GhcRn
w XRec GhcRn (HsType GhcRn)
f XRec GhcRn (HsType GhcRn)
a) | HsArrow GhcRn -> Bool
isUnrestricted HsArrow GhcRn
w = do
Core (M Type)
f1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
f
Core (M Type)
a1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
a
Core (M Type)
tcon <- MetaM (Core (M Type))
repArrowTyCon
Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)
f1, Core (M Type)
a1]
repTy (HsFunTy XFunTy GhcRn
_ HsArrow GhcRn
w XRec GhcRn (HsType GhcRn)
f XRec GhcRn (HsType GhcRn)
a) = do Core (M Type)
w1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy (HsArrow GhcRn -> XRec GhcRn (HsType GhcRn)
arrowToHsType HsArrow GhcRn
w)
Core (M Type)
f1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
f
Core (M Type)
a1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
a
Core (M Type)
tcon <- MetaM (Core (M Type))
repMulArrowTyCon
Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)
w1, Core (M Type)
f1, Core (M Type)
a1]
repTy (HsListTy XListTy GhcRn
_ XRec GhcRn (HsType GhcRn)
t) = do
Core (M Type)
t1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
t
Core (M Type)
tcon <- MetaM (Core (M Type))
repListTyCon
Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
tcon Core (M Type)
t1
repTy (HsTupleTy XTupleTy GhcRn
_ HsTupleSort
HsUnboxedTuple [XRec GhcRn (HsType GhcRn)]
tys) = do
[Core (M Type)]
tys1 <- [XRec GhcRn (HsType GhcRn)] -> MetaM [Core (M Type)]
repLTys [XRec GhcRn (HsType GhcRn)]
tys
Core (M Type)
tcon <- Int -> MetaM (Core (M Type))
repUnboxedTupleTyCon ([GenLocated SrcSpanAnnA (HsType GhcRn)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XRec GhcRn (HsType GhcRn)]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
tys)
Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)]
tys1
repTy (HsTupleTy XTupleTy GhcRn
_ HsTupleSort
_ [XRec GhcRn (HsType GhcRn)]
tys) = do [Core (M Type)]
tys1 <- [XRec GhcRn (HsType GhcRn)] -> MetaM [Core (M Type)]
repLTys [XRec GhcRn (HsType GhcRn)]
tys
Core (M Type)
tcon <- Int -> MetaM (Core (M Type))
repTupleTyCon ([GenLocated SrcSpanAnnA (HsType GhcRn)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XRec GhcRn (HsType GhcRn)]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
tys)
Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)]
tys1
repTy (HsSumTy XSumTy GhcRn
_ [XRec GhcRn (HsType GhcRn)]
tys) = do [Core (M Type)]
tys1 <- [XRec GhcRn (HsType GhcRn)] -> MetaM [Core (M Type)]
repLTys [XRec GhcRn (HsType GhcRn)]
tys
Core (M Type)
tcon <- Int -> MetaM (Core (M Type))
repUnboxedSumTyCon ([GenLocated SrcSpanAnnA (HsType GhcRn)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XRec GhcRn (HsType GhcRn)]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
tys)
Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)]
tys1
repTy (HsOpTy XOpTy GhcRn
_ PromotionFlag
prom XRec GhcRn (HsType GhcRn)
ty1 LIdP GhcRn
n XRec GhcRn (HsType GhcRn)
ty2) = XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy ((PromotionFlag -> IdP GhcRn -> XRec GhcRn (HsType GhcRn)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
prom (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
n) XRec GhcRn (HsType GhcRn)
-> XRec GhcRn (HsType GhcRn) -> XRec GhcRn (HsType GhcRn)
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy` XRec GhcRn (HsType GhcRn)
ty1)
XRec GhcRn (HsType GhcRn)
-> XRec GhcRn (HsType GhcRn) -> XRec GhcRn (HsType GhcRn)
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy` XRec GhcRn (HsType GhcRn)
ty2)
repTy (HsParTy XParTy GhcRn
_ XRec GhcRn (HsType GhcRn)
t) = XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
t
repTy (HsStarTy XStarTy GhcRn
_ Bool
_) = MetaM (Core (M Type))
repTStar
repTy (HsKindSig XKindSig GhcRn
_ XRec GhcRn (HsType GhcRn)
t XRec GhcRn (HsType GhcRn)
k) = do
Core (M Type)
t1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
t
Core (M Type)
k1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
k
Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTSig Core (M Type)
t1 Core (M Type)
k1
repTy (HsSpliceTy (HsUntypedSpliceNested Name
n) HsUntypedSplice GhcRn
_) = Name -> MetaM (Core (M Type))
forall a. Name -> MetaM (Core a)
rep_splice Name
n
repTy t :: HsType GhcRn
t@(HsSpliceTy (HsUntypedSpliceTop ThModFinalizers
_ GenLocated SrcSpanAnnA (HsType GhcRn)
_) HsUntypedSplice GhcRn
_) = String -> SDoc -> MetaM (Core (M Type))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repTy: top level splice" (HsType GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
t)
repTy (HsExplicitListTy XExplicitListTy GhcRn
_ PromotionFlag
_ [XRec GhcRn (HsType GhcRn)]
tys) = do
[Core (M Type)]
tys1 <- [XRec GhcRn (HsType GhcRn)] -> MetaM [Core (M Type)]
repLTys [XRec GhcRn (HsType GhcRn)]
tys
[Core (M Type)] -> MetaM (Core (M Type))
repTPromotedList [Core (M Type)]
tys1
repTy (HsExplicitTupleTy XExplicitTupleTy GhcRn
_ [XRec GhcRn (HsType GhcRn)]
tys) = do
[Core (M Type)]
tys1 <- [XRec GhcRn (HsType GhcRn)] -> MetaM [Core (M Type)]
repLTys [XRec GhcRn (HsType GhcRn)]
tys
Core (M Type)
tcon <- Int -> MetaM (Core (M Type))
repPromotedTupleTyCon ([GenLocated SrcSpanAnnA (HsType GhcRn)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XRec GhcRn (HsType GhcRn)]
[GenLocated SrcSpanAnnA (HsType GhcRn)]
tys)
Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)]
tys1
repTy (HsTyLit XTyLit GhcRn
_ HsTyLit GhcRn
lit) = do
Core (M TyLit)
lit' <- HsTyLit GhcRn -> MetaM (Core (M TyLit))
forall (p :: Pass). HsTyLit (GhcPass p) -> MetaM (Core (M TyLit))
repTyLit HsTyLit GhcRn
lit
Core (M TyLit) -> MetaM (Core (M Type))
repTLit Core (M TyLit)
lit'
repTy (HsWildCardTy XWildCardTy GhcRn
_) = MetaM (Core (M Type))
repTWildCard
repTy (HsIParamTy XIParamTy GhcRn
_ XRec GhcRn HsIPName
n XRec GhcRn (HsType GhcRn)
t) = do
Core String
n' <- HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name (GenLocated (SrcAnn NoEpAnns) HsIPName -> HsIPName
forall l e. GenLocated l e -> e
unLoc XRec GhcRn HsIPName
GenLocated (SrcAnn NoEpAnns) HsIPName
n)
Core (M Type)
t' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
t
Core String -> Core (M Type) -> MetaM (Core (M Type))
repTImplicitParam Core String
n' Core (M Type)
t'
repTy HsType GhcRn
ty = ThRejectionReason -> MetaM (Core (M Type))
forall a. ThRejectionReason -> MetaM a
notHandled (HsType GhcRn -> ThRejectionReason
ThExoticFormOfType HsType GhcRn
ty)
repTyLit :: HsTyLit (GhcPass p) -> MetaM (Core (M TH.TyLit))
repTyLit :: forall (p :: Pass). HsTyLit (GhcPass p) -> MetaM (Core (M TyLit))
repTyLit (HsNumTy XNumTy (GhcPass p)
_ Integer
i) = do
Platform
platform <- MetaM Platform
getPlatform
Name -> [CoreExpr] -> MetaM (Core (M TyLit))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
numTyLitName [Platform -> Integer -> CoreExpr
mkIntegerExpr Platform
platform Integer
i]
repTyLit (HsStrTy XStrTy (GhcPass p)
_ FastString
s) = do { CoreExpr
s' <- FastString -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
mkStringExprFS FastString
s
; Name -> [CoreExpr] -> MetaM (Core (M TyLit))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
strTyLitName [CoreExpr
s']
}
repTyLit (HsCharTy XCharTy (GhcPass p)
_ Char
c) = do { CoreExpr
c' <- CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> CoreExpr
mkCharExpr Char
c)
; Name -> [CoreExpr] -> MetaM (Core (M TyLit))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
charTyLitName [CoreExpr
c']
}
repMaybeLTy :: Maybe (LHsKind GhcRn)
-> MetaM (Core (Maybe (M TH.Type)))
repMaybeLTy :: Maybe (XRec GhcRn (HsType GhcRn)) -> MetaM (Core (Maybe (M Type)))
repMaybeLTy Maybe (XRec GhcRn (HsType GhcRn))
m = do
Type
k_ty <- Name -> MetaM Type
wrapName Name
kindTyConName
Type
-> (GenLocated SrcSpanAnnA (HsType GhcRn) -> MetaM (Core (M Type)))
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcRn))
-> MetaM (Core (Maybe (M Type)))
forall a b.
Type -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
repMaybeT Type
k_ty XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
GenLocated SrcSpanAnnA (HsType GhcRn) -> MetaM (Core (M Type))
repLTy Maybe (XRec GhcRn (HsType GhcRn))
Maybe (GenLocated SrcSpanAnnA (HsType GhcRn))
m
repRole :: LocatedAn NoEpAnns (Maybe Role) -> MetaM (Core TH.Role)
repRole :: LocatedAn NoEpAnns (Maybe Role)
-> ReaderT MetaWrappers DsM (Core Role)
repRole (L SrcAnn NoEpAnns
_ (Just Role
Nominal)) = Name -> [CoreExpr] -> ReaderT MetaWrappers DsM (Core Role)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
nominalRName []
repRole (L SrcAnn NoEpAnns
_ (Just Role
Representational)) = Name -> [CoreExpr] -> ReaderT MetaWrappers DsM (Core Role)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
representationalRName []
repRole (L SrcAnn NoEpAnns
_ (Just Role
Phantom)) = Name -> [CoreExpr] -> ReaderT MetaWrappers DsM (Core Role)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
phantomRName []
repRole (L SrcAnn NoEpAnns
_ Maybe Role
Nothing) = Name -> [CoreExpr] -> ReaderT MetaWrappers DsM (Core Role)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
inferRName []
rep_splice :: Name -> MetaM (Core a)
rep_splice :: forall a. Name -> MetaM (Core a)
rep_splice Name
splice_name
= do { Maybe DsMetaVal
mb_val <- IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
-> ReaderT MetaWrappers DsM (Maybe DsMetaVal)
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
-> ReaderT MetaWrappers DsM (Maybe DsMetaVal))
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
-> ReaderT MetaWrappers DsM (Maybe DsMetaVal)
forall a b. (a -> b) -> a -> b
$ Name -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
dsLookupMetaEnv Name
splice_name
; case Maybe DsMetaVal
mb_val of
Just (DsSplice HsExpr GhcTc
e) -> do { CoreExpr
e' <- DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr)
-> DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ HsExpr GhcTc -> DsM CoreExpr
dsExpr HsExpr GhcTc
e
; Core a -> MetaM (Core a)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core a
forall a. CoreExpr -> Core a
MkC CoreExpr
e') }
Maybe DsMetaVal
_ -> String -> SDoc -> MetaM (Core a)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"HsSplice" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
splice_name) }
repLEs :: [LHsExpr GhcRn] -> MetaM (Core [(M TH.Exp)])
repLEs :: [LHsExpr GhcRn] -> MetaM (Core [M Exp])
repLEs [LHsExpr GhcRn]
es = Name
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> MetaM (Core (M Exp)))
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> MetaM (Core [M Exp])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
expTyConName LHsExpr GhcRn -> MetaM (Core (M Exp))
GenLocated SrcSpanAnnA (HsExpr GhcRn) -> MetaM (Core (M Exp))
repLE [LHsExpr GhcRn]
[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
es
repLE :: LHsExpr GhcRn -> MetaM (Core (M TH.Exp))
repLE :: LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE (L SrcSpanAnnA
loc HsExpr GhcRn
e) = (IOEnv (Env DsGblEnv DsLclEnv) (Core (M Exp))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core (M Exp)))
-> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (SrcSpan
-> IOEnv (Env DsGblEnv DsLclEnv) (Core (M Exp))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core (M Exp))
forall a. SrcSpan -> DsM a -> DsM a
putSrcSpanDs (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)) (HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
e)
repE :: HsExpr GhcRn -> MetaM (Core (M TH.Exp))
repE :: HsExpr GhcRn -> MetaM (Core (M Exp))
repE (HsVar XVar GhcRn
_ (L SrcSpanAnnN
_ Name
x)) =
do { Maybe DsMetaVal
mb_val <- IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
-> ReaderT MetaWrappers DsM (Maybe DsMetaVal)
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
-> ReaderT MetaWrappers DsM (Maybe DsMetaVal))
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
-> ReaderT MetaWrappers DsM (Maybe DsMetaVal)
forall a b. (a -> b) -> a -> b
$ Name -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
dsLookupMetaEnv Name
x
; case Maybe DsMetaVal
mb_val of
Maybe DsMetaVal
Nothing -> do { Core Name
str <- DsM (Core Name) -> MetaM (Core Name)
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM (Core Name) -> MetaM (Core Name))
-> DsM (Core Name) -> MetaM (Core Name)
forall a b. (a -> b) -> a -> b
$ Name -> DsM (Core Name)
globalVar Name
x
; Name -> Core Name -> MetaM (Core (M Exp))
repVarOrCon Name
x Core Name
str }
Just (DsBound Id
y) -> Name -> Core Name -> MetaM (Core (M Exp))
repVarOrCon Name
x (Id -> Core Name
coreVar Id
y)
Just (DsSplice HsExpr GhcTc
e) -> do { CoreExpr
e' <- DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr)
-> DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ HsExpr GhcTc -> DsM CoreExpr
dsExpr HsExpr GhcTc
e
; Core (M Exp) -> MetaM (Core (M Exp))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core (M Exp)
forall a. CoreExpr -> Core a
MkC CoreExpr
e') } }
repE (HsIPVar XIPVar GhcRn
_ HsIPName
n) = HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name HsIPName
n ReaderT MetaWrappers DsM (Core String)
-> (Core String -> MetaM (Core (M Exp))) -> MetaM (Core (M Exp))
forall a b.
ReaderT MetaWrappers DsM a
-> (a -> ReaderT MetaWrappers DsM b) -> ReaderT MetaWrappers DsM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Core String -> MetaM (Core (M Exp))
repImplicitParamVar
repE (HsOverLabel XOverLabel GhcRn
_ SourceText
_ FastString
s) = FastString -> MetaM (Core (M Exp))
repOverLabel FastString
s
repE (HsRecSel XRecSel GhcRn
_ (FieldOcc XCFieldOcc GhcRn
x XRec GhcRn RdrName
_)) = HsExpr GhcRn -> MetaM (Core (M Exp))
repE (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (Name -> GenLocated SrcSpanAnnN Name
forall a an. a -> LocatedAn an a
noLocA XCFieldOcc GhcRn
Name
x))
repE (HsOverLit XOverLitE GhcRn
_ HsOverLit GhcRn
l) = do { Core Lit
a <- HsOverLit GhcRn -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit GhcRn
l; Core Lit -> MetaM (Core (M Exp))
repLit Core Lit
a }
repE (HsLit XLitE GhcRn
_ HsLit GhcRn
l) = do { Core Lit
a <- HsLit GhcRn -> MetaM (Core Lit)
repLiteral HsLit GhcRn
l; Core Lit -> MetaM (Core (M Exp))
repLit Core Lit
a }
repE (HsLam XLam GhcRn
_ (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
m]) })) = LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M Exp))
repLambda LMatch GhcRn (LHsExpr GhcRn)
GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
m
repE e :: HsExpr GhcRn
e@(HsLam XLam GhcRn
_ (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
_) })) = String -> SDoc -> MetaM (Core (M Exp))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repE: HsLam with multiple alternatives" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)
repE (HsLamCase XLamCase GhcRn
_ LamCaseVariant
LamCase (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
ms) }))
= do { [Core (M Match)]
ms' <- (GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Match)))
-> [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> ReaderT MetaWrappers DsM [Core (M Match)]
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 LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Match))
GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatchTup [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
ms
; Core [M Match]
core_ms <- Name -> [Core (M Match)] -> MetaM (Core [M Match])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
matchTyConName [Core (M Match)]
ms'
; Core [M Match] -> MetaM (Core (M Exp))
repLamCase Core [M Match]
core_ms }
repE (HsLamCase XLamCase GhcRn
_ LamCaseVariant
LamCases (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
ms) }))
= do { [Core (M Clause)]
ms' <- (GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Clause)))
-> [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> ReaderT MetaWrappers DsM [Core (M Clause)]
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 LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Clause))
GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClauseTup [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
ms
; Core [M Clause]
core_ms <- Name -> [Core (M Clause)] -> MetaM (Core [M Clause])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
matchTyConName [Core (M Clause)]
ms'
; Core [M Clause] -> MetaM (Core (M Exp))
repLamCases Core [M Clause]
core_ms }
repE (HsApp XApp GhcRn
_ LHsExpr GhcRn
x LHsExpr GhcRn
y) = do {Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x; Core (M Exp)
b <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
y; Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repApp Core (M Exp)
a Core (M Exp)
b}
repE (HsAppType XAppTypeE GhcRn
_ LHsExpr GhcRn
e LHsToken "@" GhcRn
_ LHsWcType (NoGhcTc GhcRn)
t)
= do { Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
; Core (M Type)
s <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcRn)
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
t)
; Core (M Exp) -> Core (M Type) -> MetaM (Core (M Exp))
repAppType Core (M Exp)
a Core (M Type)
s }
repE (OpApp XOpApp GhcRn
_ LHsExpr GhcRn
e1 LHsExpr GhcRn
op LHsExpr GhcRn
e2) =
do { Core (M Exp)
arg1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e1;
Core (M Exp)
arg2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e2;
Core (M Exp)
the_op <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
op ;
Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repInfixApp Core (M Exp)
arg1 Core (M Exp)
the_op Core (M Exp)
arg2 }
repE (NegApp XNegApp GhcRn
_ LHsExpr GhcRn
x SyntaxExpr GhcRn
_) = do
Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x
Core (M Exp)
negateVar <- Name -> MetaM (Core Name)
lookupOcc Name
negateName MetaM (Core Name)
-> (Core Name -> MetaM (Core (M Exp))) -> MetaM (Core (M Exp))
forall a b.
ReaderT MetaWrappers DsM a
-> (a -> ReaderT MetaWrappers DsM b) -> ReaderT MetaWrappers DsM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Core Name -> MetaM (Core (M Exp))
repVar
Core (M Exp)
negateVar Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
`repApp` Core (M Exp)
a
repE (HsPar XPar GhcRn
_ LHsToken "(" GhcRn
_ LHsExpr GhcRn
x LHsToken ")" GhcRn
_) = LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x
repE (SectionL XSectionL GhcRn
_ LHsExpr GhcRn
x LHsExpr GhcRn
y) = do { Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x; Core (M Exp)
b <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
y; Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repSectionL Core (M Exp)
a Core (M Exp)
b }
repE (SectionR XSectionR GhcRn
_ LHsExpr GhcRn
x LHsExpr GhcRn
y) = do { Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x; Core (M Exp)
b <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
y; Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repSectionR Core (M Exp)
a Core (M Exp)
b }
repE (HsCase XCase GhcRn
_ LHsExpr GhcRn
e (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
ms) }))
= do { Core (M Exp)
arg <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
; [Core (M Match)]
ms2 <- (GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Match)))
-> [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> ReaderT MetaWrappers DsM [Core (M Match)]
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 LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Match))
GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatchTup [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
ms
; Core [M Match]
core_ms2 <- Name -> [Core (M Match)] -> MetaM (Core [M Match])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
matchTyConName [Core (M Match)]
ms2
; Core (M Exp) -> Core [M Match] -> MetaM (Core (M Exp))
repCaseE Core (M Exp)
arg Core [M Match]
core_ms2 }
repE (HsIf XIf GhcRn
_ LHsExpr GhcRn
x LHsExpr GhcRn
y LHsExpr GhcRn
z) = do
Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x
Core (M Exp)
b <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
y
Core (M Exp)
c <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
z
Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repCond Core (M Exp)
a Core (M Exp)
b Core (M Exp)
c
repE (HsMultiIf XMultiIf GhcRn
_ [LGRHS GhcRn (LHsExpr GhcRn)]
alts)
= do { ([[GenSymBind]]
binds, [Core (M (Guard, Exp))]
alts') <- ([([GenSymBind], Core (M (Guard, Exp)))]
-> ([[GenSymBind]], [Core (M (Guard, Exp))]))
-> ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
-> ReaderT
MetaWrappers DsM ([[GenSymBind]], [Core (M (Guard, Exp))])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [([GenSymBind], Core (M (Guard, Exp)))]
-> ([[GenSymBind]], [Core (M (Guard, Exp))])
forall a b. [(a, b)] -> ([a], [b])
unzip (ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
-> ReaderT
MetaWrappers DsM ([[GenSymBind]], [Core (M (Guard, Exp))]))
-> ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
-> ReaderT
MetaWrappers DsM ([[GenSymBind]], [Core (M (Guard, Exp))])
forall a b. (a -> b) -> a -> b
$ (GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp))))
-> [GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
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 LGRHS GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
repLGRHS [LGRHS GhcRn (LHsExpr GhcRn)]
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts
; Core (M Exp)
expr' <- Core [M (Guard, Exp)] -> MetaM (Core (M Exp))
repMultiIf ([Core (M (Guard, Exp))] -> Core [M (Guard, Exp)]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M (Guard, Exp))]
alts')
; [GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms ([[GenSymBind]] -> [GenSymBind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenSymBind]]
binds) Core (M Exp)
expr' }
repE (HsLet XLet GhcRn
_ LHsToken "let" GhcRn
_ HsLocalBinds GhcRn
bs LHsToken "in" GhcRn
_ LHsExpr GhcRn
e) = do { ([GenSymBind]
ss,Core [M Dec]
ds) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
bs
; Core (M Exp)
e2 <- [GenSymBind] -> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e)
; Core (M Exp)
z <- Core [M Dec] -> Core (M Exp) -> MetaM (Core (M Exp))
repLetE Core [M Dec]
ds Core (M Exp)
e2
; [GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
z }
repE e :: HsExpr GhcRn
e@(HsDo XDo GhcRn
_ HsDoFlavour
ctxt (L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
sts))
| Just Maybe ModuleName
maybeModuleName <- case HsDoFlavour
ctxt of
{ DoExpr Maybe ModuleName
m -> Maybe ModuleName -> Maybe (Maybe ModuleName)
forall a. a -> Maybe a
Just Maybe ModuleName
m; HsDoFlavour
GhciStmtCtxt -> Maybe ModuleName -> Maybe (Maybe ModuleName)
forall a. a -> Maybe a
Just Maybe ModuleName
forall a. Maybe a
Nothing; HsDoFlavour
_ -> Maybe (Maybe ModuleName)
forall a. Maybe a
Nothing }
= do { ([GenSymBind]
ss,[Core (M Stmt)]
zs) <- [ExprLStmt GhcRn] -> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt GhcRn]
[GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
sts;
Core (M Exp)
e' <- Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoE Maybe ModuleName
maybeModuleName ([Core (M Stmt)] -> Core [M Stmt]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Stmt)]
zs);
[GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
e' }
| HsDoFlavour
ListComp <- HsDoFlavour
ctxt
= do { ([GenSymBind]
ss,[Core (M Stmt)]
zs) <- [ExprLStmt GhcRn] -> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt GhcRn]
[GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
sts;
Core (M Exp)
e' <- Core [M Stmt] -> MetaM (Core (M Exp))
repComp ([Core (M Stmt)] -> Core [M Stmt]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Stmt)]
zs);
[GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
e' }
| MDoExpr Maybe ModuleName
maybeModuleName <- HsDoFlavour
ctxt
= do { ([GenSymBind]
ss,[Core (M Stmt)]
zs) <- [ExprLStmt GhcRn] -> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt GhcRn]
[GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
sts;
Core (M Exp)
e' <- Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repMDoE Maybe ModuleName
maybeModuleName ([Core (M Stmt)] -> Core [M Stmt]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Stmt)]
zs);
[GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
e' }
| Bool
otherwise
= ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr GhcRn -> ThRejectionReason
ThMonadComprehensionSyntax HsExpr GhcRn
e)
repE (ExplicitList XExplicitList GhcRn
_ [LHsExpr GhcRn]
es) = do { Core [M Exp]
xs <- [LHsExpr GhcRn] -> MetaM (Core [M Exp])
repLEs [LHsExpr GhcRn]
es; Core [M Exp] -> MetaM (Core (M Exp))
repListExp Core [M Exp]
xs }
repE (ExplicitTuple XExplicitTuple GhcRn
_ [HsTupArg GhcRn]
es Boxity
boxity) =
let tupArgToCoreExp :: HsTupArg GhcRn -> MetaM (Core (Maybe (M TH.Exp)))
tupArgToCoreExp :: HsTupArg GhcRn -> MetaM (Core (Maybe (M Exp)))
tupArgToCoreExp HsTupArg GhcRn
a
| (Present XPresent GhcRn
_ LHsExpr GhcRn
e) <- HsTupArg GhcRn
a = do { Core (M Exp)
e' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
; Name -> Core (M Exp) -> MetaM (Core (Maybe (M Exp)))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJustM Name
expTyConName Core (M Exp)
e' }
| Bool
otherwise = Name -> MetaM (Core (Maybe (M Exp)))
forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
expTyConName
in do { [Core (Maybe (M Exp))]
args <- (HsTupArg GhcRn -> MetaM (Core (Maybe (M Exp))))
-> [HsTupArg GhcRn]
-> ReaderT MetaWrappers DsM [Core (Maybe (M Exp))]
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 HsTupArg GhcRn -> MetaM (Core (Maybe (M Exp)))
tupArgToCoreExp [HsTupArg GhcRn]
es
; Type
expTy <- Name -> MetaM Type
wrapName Name
expTyConName
; let maybeExpQTy :: Type
maybeExpQTy = TyCon -> [Type] -> Type
mkTyConApp TyCon
maybeTyCon [Type
expTy]
listArg :: Core [Maybe (M Exp)]
listArg = Type -> [Core (Maybe (M Exp))] -> Core [Maybe (M Exp)]
forall a. Type -> [Core a] -> Core [a]
coreList' Type
maybeExpQTy [Core (Maybe (M Exp))]
args
; if Boxity -> Bool
isBoxed Boxity
boxity
then Core [Maybe (M Exp)] -> MetaM (Core (M Exp))
repTup Core [Maybe (M Exp)]
listArg
else Core [Maybe (M Exp)] -> MetaM (Core (M Exp))
repUnboxedTup Core [Maybe (M Exp)]
listArg }
repE (ExplicitSum XExplicitSum GhcRn
_ Int
alt Int
arity LHsExpr GhcRn
e)
= do { Core (M Exp)
e1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
; Core (M Exp) -> Int -> Int -> MetaM (Core (M Exp))
repUnboxedSum Core (M Exp)
e1 Int
alt Int
arity }
repE (RecordCon { rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
rcon_con = XRec GhcRn (ConLikeP GhcRn)
c, rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = HsRecordBinds GhcRn
flds })
= do { Core Name
x <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN Name
c;
Core [M FieldExp]
fs <- HsRecordBinds GhcRn -> MetaM (Core [M FieldExp])
repFields HsRecordBinds GhcRn
flds;
Core Name -> Core [M FieldExp] -> MetaM (Core (M Exp))
repRecCon Core Name
x Core [M FieldExp]
fs }
repE (RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr GhcRn
e, rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds = Left [LHsRecUpdField GhcRn]
flds })
= do { Core (M Exp)
x <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e;
Core [M FieldExp]
fs <- [LHsRecUpdField GhcRn] -> MetaM (Core [M FieldExp])
repUpdFields [LHsRecUpdField GhcRn]
flds;
Core (M Exp) -> Core [M FieldExp] -> MetaM (Core (M Exp))
repRecUpd Core (M Exp)
x Core [M FieldExp]
fs }
repE (RecordUpd { rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds = Right [LHsRecUpdProj GhcRn]
_ })
= do
String -> MetaM (Core (M Exp))
forall a. HasCallStack => String -> a
panic String
"The impossible has happened!"
repE (ExprWithTySig XExprWithTySig GhcRn
_ LHsExpr GhcRn
e LHsSigWcType (NoGhcTc GhcRn)
wc_ty)
= FreshOrReuse
-> [Name] -> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a.
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
FreshNamesOnly (LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig LHsSigType GhcRn
sig_ty) (MetaM (Core (M Exp)) -> MetaM (Core (M Exp)))
-> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a b. (a -> b) -> a -> b
$
do { Core (M Exp)
e1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
; Core (M Type)
t1 <- LHsSigType GhcRn -> MetaM (Core (M Type))
rep_ty_sig' LHsSigType GhcRn
sig_ty
; Core (M Exp) -> Core (M Type) -> MetaM (Core (M Exp))
repSigExp Core (M Exp)
e1 Core (M Type)
t1 }
where
sig_ty :: LHsSigType GhcRn
sig_ty = LHsSigWcType GhcRn -> LHsSigType GhcRn
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType (NoGhcTc GhcRn)
LHsSigWcType GhcRn
wc_ty
repE (ArithSeq XArithSeq GhcRn
_ Maybe (SyntaxExpr GhcRn)
_ ArithSeqInfo GhcRn
aseq) =
case ArithSeqInfo GhcRn
aseq of
From LHsExpr GhcRn
e -> do { Core (M Exp)
ds1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e; Core (M Exp) -> MetaM (Core (M Exp))
repFrom Core (M Exp)
ds1 }
FromThen LHsExpr GhcRn
e1 LHsExpr GhcRn
e2 -> do
Core (M Exp)
ds1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e1
Core (M Exp)
ds2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e2
Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repFromThen Core (M Exp)
ds1 Core (M Exp)
ds2
FromTo LHsExpr GhcRn
e1 LHsExpr GhcRn
e2 -> do
Core (M Exp)
ds1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e1
Core (M Exp)
ds2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e2
Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repFromTo Core (M Exp)
ds1 Core (M Exp)
ds2
FromThenTo LHsExpr GhcRn
e1 LHsExpr GhcRn
e2 LHsExpr GhcRn
e3 -> do
Core (M Exp)
ds1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e1
Core (M Exp)
ds2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e2
Core (M Exp)
ds3 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e3
Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repFromThenTo Core (M Exp)
ds1 Core (M Exp)
ds2 Core (M Exp)
ds3
repE (HsTypedSplice XTypedSplice GhcRn
n LHsExpr GhcRn
_) = Name -> MetaM (Core (M Exp))
forall a. Name -> MetaM (Core a)
rep_splice XTypedSplice GhcRn
Name
n
repE (HsUntypedSplice (HsUntypedSpliceNested Name
n) HsUntypedSplice GhcRn
_) = Name -> MetaM (Core (M Exp))
forall a. Name -> MetaM (Core a)
rep_splice Name
n
repE e :: HsExpr GhcRn
e@(HsUntypedSplice (HsUntypedSpliceTop ThModFinalizers
_ HsExpr GhcRn
_) HsUntypedSplice GhcRn
_) = String -> SDoc -> MetaM (Core (M Exp))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repE: top level splice" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)
repE (HsStatic XStatic GhcRn
_ LHsExpr GhcRn
e) = LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e MetaM (Core (M Exp))
-> (Core (M Exp) -> MetaM (Core (M Exp))) -> MetaM (Core (M Exp))
forall a b.
ReaderT MetaWrappers DsM a
-> (a -> ReaderT MetaWrappers DsM b) -> ReaderT MetaWrappers DsM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
staticEName ([CoreExpr] -> MetaM (Core (M Exp)))
-> (Core (M Exp) -> [CoreExpr])
-> Core (M Exp)
-> MetaM (Core (M Exp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoreExpr -> [CoreExpr] -> [CoreExpr]
forall a. a -> [a] -> [a]
:[]) (CoreExpr -> [CoreExpr])
-> (Core (M Exp) -> CoreExpr) -> Core (M Exp) -> [CoreExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Core (M Exp) -> CoreExpr
forall a. Core a -> CoreExpr
unC
repE (HsUnboundVar XUnboundVar GhcRn
_ RdrName
uv) = do
Core Name
name <- RdrName -> MetaM (Core Name)
repRdrName RdrName
uv
Core Name -> MetaM (Core (M Exp))
repUnboundVar Core Name
name
repE (HsGetField XGetField GhcRn
_ LHsExpr GhcRn
e (L SrcAnn NoEpAnns
_ (DotFieldOcc XCDotFieldOcc GhcRn
_ (L SrcSpanAnnN
_ (FieldLabelString FastString
f))))) = do
Core (M Exp)
e1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
Core (M Exp) -> FastString -> MetaM (Core (M Exp))
repGetField Core (M Exp)
e1 FastString
f
repE (HsProjection XProjection GhcRn
_ NonEmpty (XRec GhcRn (DotFieldOcc GhcRn))
xs) = NonEmpty FastString -> MetaM (Core (M Exp))
repProjection ((GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn) -> FastString)
-> NonEmpty (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn))
-> NonEmpty FastString
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldLabelString -> FastString
field_label (FieldLabelString -> FastString)
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn)
-> FieldLabelString)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn)
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString)
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn)
-> GenLocated SrcSpanAnnN FieldLabelString)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn)
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotFieldOcc GhcRn -> XRec GhcRn FieldLabelString
DotFieldOcc GhcRn -> GenLocated SrcSpanAnnN FieldLabelString
forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel (DotFieldOcc GhcRn -> GenLocated SrcSpanAnnN FieldLabelString)
-> (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn)
-> DotFieldOcc GhcRn)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn)
-> GenLocated SrcSpanAnnN FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn)
-> DotFieldOcc GhcRn
forall l e. GenLocated l e -> e
unLoc) NonEmpty (XRec GhcRn (DotFieldOcc GhcRn))
NonEmpty (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc GhcRn))
xs)
repE (XExpr (HsExpanded HsExpr GhcRn
orig_expr HsExpr GhcRn
ds_expr))
= do { Bool
rebindable_on <- DsM Bool -> ReaderT MetaWrappers DsM Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM Bool -> ReaderT MetaWrappers DsM Bool)
-> DsM Bool -> ReaderT MetaWrappers DsM Bool
forall a b. (a -> b) -> a -> b
$ Extension -> DsM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool
rebindable_on
then HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
ds_expr
else HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
orig_expr }
repE e :: HsExpr GhcRn
e@(HsPragE XPragE GhcRn
_ (HsPragSCC {}) LHsExpr GhcRn
_) = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr GhcRn -> ThRejectionReason
ThCostCentres HsExpr GhcRn
e)
repE e :: HsExpr GhcRn
e@(HsTypedBracket{}) = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr GhcRn -> ThRejectionReason
ThExpressionForm HsExpr GhcRn
e)
repE e :: HsExpr GhcRn
e@(HsUntypedBracket{}) = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr GhcRn -> ThRejectionReason
ThExpressionForm HsExpr GhcRn
e)
repE e :: HsExpr GhcRn
e@(HsProc{}) = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr GhcRn -> ThRejectionReason
ThExpressionForm HsExpr GhcRn
e)
repMatchTup :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Match))
repMatchTup :: LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatchTup (L SrcSpanAnnA
_ (Match { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcRn
p]
, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [LGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
guards HsLocalBinds GhcRn
wheres })) =
do { [GenSymBind]
ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms (CollectFlag GhcRn -> LPat GhcRn -> [IdP GhcRn]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders LPat GhcRn
p)
; [GenSymBind]
-> ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 (ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match)))
-> ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match))
forall a b. (a -> b) -> a -> b
$ do {
; Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
; ([GenSymBind]
ss2,Core [M Dec]
ds) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
wheres
; [GenSymBind]
-> ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss2 (ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match)))
-> ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match))
forall a b. (a -> b) -> a -> b
$ do {
; Core (M Body)
gs <- [LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
[LGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
guards
; Core (M Match)
match <- Core (M Pat)
-> Core (M Body)
-> Core [M Dec]
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatch Core (M Pat)
p1 Core (M Body)
gs Core [M Dec]
ds
; [GenSymBind]
-> Core (M Match) -> ReaderT MetaWrappers DsM (Core (M Match))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2) Core (M Match)
match }}}
repMatchTup LMatch GhcRn (LHsExpr GhcRn)
_ = String -> ReaderT MetaWrappers DsM (Core (M Match))
forall a. HasCallStack => String -> a
panic String
"repMatchTup: case alt with more than one arg"
repClauseTup :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Clause))
repClauseTup :: LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClauseTup (L SrcSpanAnnA
_ (Match { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcRn]
ps
, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [LGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
guards HsLocalBinds GhcRn
wheres })) =
do { [GenSymBind]
ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms (CollectFlag GhcRn -> [LPat GhcRn] -> [IdP GhcRn]
forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders [LPat GhcRn]
ps)
; [GenSymBind]
-> ReaderT MetaWrappers DsM (Core (M Clause))
-> ReaderT MetaWrappers DsM (Core (M Clause))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 (ReaderT MetaWrappers DsM (Core (M Clause))
-> ReaderT MetaWrappers DsM (Core (M Clause)))
-> ReaderT MetaWrappers DsM (Core (M Clause))
-> ReaderT MetaWrappers DsM (Core (M Clause))
forall a b. (a -> b) -> a -> b
$ do {
Core [M Pat]
ps1 <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps
; ([GenSymBind]
ss2,Core [M Dec]
ds) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
wheres
; [GenSymBind]
-> ReaderT MetaWrappers DsM (Core (M Clause))
-> ReaderT MetaWrappers DsM (Core (M Clause))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss2 (ReaderT MetaWrappers DsM (Core (M Clause))
-> ReaderT MetaWrappers DsM (Core (M Clause)))
-> ReaderT MetaWrappers DsM (Core (M Clause))
-> ReaderT MetaWrappers DsM (Core (M Clause))
forall a b. (a -> b) -> a -> b
$ do {
Core (M Body)
gs <- [LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
[LGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
guards
; Core (M Clause)
clause <- Core [M Pat]
-> Core (M Body)
-> Core [M Dec]
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClause Core [M Pat]
ps1 Core (M Body)
gs Core [M Dec]
ds
; [GenSymBind]
-> Core (M Clause) -> ReaderT MetaWrappers DsM (Core (M Clause))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2) Core (M Clause)
clause }}}
repGuards :: [LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M TH.Body))
repGuards :: [LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [L SrcAnn NoEpAnns
_ (GRHS XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [] GenLocated SrcSpanAnnA (HsExpr GhcRn)
e)]
= do {Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e; Core (M Exp) -> MetaM (Core (M Body))
repNormal Core (M Exp)
a }
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
other
= do { [([GenSymBind], Core (M (Guard, Exp)))]
zs <- (GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp))))
-> [GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
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 LGRHS GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
repLGRHS [LGRHS GhcRn (LHsExpr GhcRn)]
[GenLocated
(SrcAnn NoEpAnns)
(GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
other
; let ([[GenSymBind]]
xs, [Core (M (Guard, Exp))]
ys) = [([GenSymBind], Core (M (Guard, Exp)))]
-> ([[GenSymBind]], [Core (M (Guard, Exp))])
forall a b. [(a, b)] -> ([a], [b])
unzip [([GenSymBind], Core (M (Guard, Exp)))]
zs
; Core (M Body)
gd <- Core [M (Guard, Exp)] -> MetaM (Core (M Body))
repGuarded ([Core (M (Guard, Exp))] -> Core [M (Guard, Exp)]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M (Guard, Exp))]
ys)
; [GenSymBind] -> Core (M Body) -> MetaM (Core (M Body))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms ([[GenSymBind]] -> [GenSymBind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenSymBind]]
xs) Core (M Body)
gd }
repLGRHS :: LGRHS GhcRn (LHsExpr GhcRn)
-> MetaM ([GenSymBind], (Core (M (TH.Guard, TH.Exp))))
repLGRHS :: LGRHS GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
repLGRHS (L SrcAnn NoEpAnns
_ (GRHS XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ GenLocated SrcSpanAnnA (HsExpr GhcRn)
e1 SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_)] GenLocated SrcSpanAnnA (HsExpr GhcRn)
e2))
= do { Core (M (Guard, Exp))
guarded <- LHsExpr GhcRn -> LHsExpr GhcRn -> MetaM (Core (M (Guard, Exp)))
repLNormalGE LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e1 LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e2
; ([GenSymBind], Core (M (Guard, Exp)))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Core (M (Guard, Exp))
guarded) }
repLGRHS (L SrcAnn NoEpAnns
_ (GRHS XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [ExprLStmt GhcRn]
ss GenLocated SrcSpanAnnA (HsExpr GhcRn)
rhs))
= do { ([GenSymBind]
gs, [Core (M Stmt)]
ss') <- [ExprLStmt GhcRn] -> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt GhcRn]
ss
; Core (M Exp)
rhs' <- [GenSymBind] -> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
gs (MetaM (Core (M Exp)) -> MetaM (Core (M Exp)))
-> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
rhs
; Core (M (Guard, Exp))
guarded <- Core [M Stmt] -> Core (M Exp) -> MetaM (Core (M (Guard, Exp)))
repPatGE ([Core (M Stmt)] -> Core [M Stmt]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Stmt)]
ss') Core (M Exp)
rhs'
; ([GenSymBind], Core (M (Guard, Exp)))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
gs, Core (M (Guard, Exp))
guarded) }
repFields :: HsRecordBinds GhcRn -> MetaM (Core [M TH.FieldExp])
repFields :: HsRecordBinds GhcRn -> MetaM (Core [M FieldExp])
repFields (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [LHsRecField GhcRn (LHsExpr GhcRn)]
flds })
= Name
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> MetaM (Core (M FieldExp)))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> MetaM (Core [M FieldExp])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
fieldExpTyConName LHsRecField GhcRn (LHsExpr GhcRn) -> MetaM (Core (M FieldExp))
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> MetaM (Core (M FieldExp))
rep_fld [LHsRecField GhcRn (LHsExpr GhcRn)]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
flds
where
rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn)
-> MetaM (Core (M TH.FieldExp))
rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn) -> MetaM (Core (M FieldExp))
rep_fld (L SrcSpanAnnA
_ HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
fld) = do { Core Name
fn <- Name -> MetaM (Core Name)
lookupOcc (HsRecField GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> XCFieldOcc GhcRn
forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
hsRecFieldSel HsRecField GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
fld)
; Core (M Exp)
e <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
fld)
; Core Name -> Core (M Exp) -> MetaM (Core (M FieldExp))
repFieldExp Core Name
fn Core (M Exp)
e }
repUpdFields :: [LHsRecUpdField GhcRn] -> MetaM (Core [M TH.FieldExp])
repUpdFields :: [LHsRecUpdField GhcRn] -> MetaM (Core [M FieldExp])
repUpdFields = Name
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> MetaM (Core (M FieldExp)))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> MetaM (Core [M FieldExp])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
fieldExpTyConName LHsRecUpdField GhcRn -> MetaM (Core (M FieldExp))
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> MetaM (Core (M FieldExp))
rep_fld
where
rep_fld :: LHsRecUpdField GhcRn -> MetaM (Core (M TH.FieldExp))
rep_fld :: LHsRecUpdField GhcRn -> MetaM (Core (M FieldExp))
rep_fld (L SrcSpanAnnA
l HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
fld) = case GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)
-> AmbiguousFieldOcc GhcRn
forall l e. GenLocated l e -> e
unLoc (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
fld) of
Unambiguous XUnambiguous GhcRn
sel_name XRec GhcRn RdrName
_ -> do { Core Name
fn <- GenLocated SrcSpanAnnA Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc (SrcSpanAnnA -> Name -> GenLocated SrcSpanAnnA Name
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l XUnambiguous GhcRn
Name
sel_name)
; Core (M Exp)
e <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
fld)
; Core Name -> Core (M Exp) -> MetaM (Core (M FieldExp))
repFieldExp Core Name
fn Core (M Exp)
e }
Ambiguous{} -> ThRejectionReason -> MetaM (Core (M FieldExp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsRecUpdField GhcRn -> ThRejectionReason
ThAmbiguousRecordUpdates HsRecUpdField GhcRn
HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
fld)
repLSts :: [LStmt GhcRn (LHsExpr GhcRn)] -> MetaM ([GenSymBind], [Core (M TH.Stmt)])
repLSts :: [ExprLStmt GhcRn] -> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt GhcRn]
stmts = [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts ((GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc [ExprLStmt GhcRn]
[GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts)
repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> MetaM ([GenSymBind], [Core (M TH.Stmt)])
repSts :: [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts (BindStmt XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
_ LPat GhcRn
p LHsExpr GhcRn
e : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
do { Core (M Exp)
e2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
; [GenSymBind]
ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms (CollectFlag GhcRn -> LPat GhcRn -> [IdP GhcRn]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders LPat GhcRn
p)
; [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 (MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)]))
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a b. (a -> b) -> a -> b
$ do {
; Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p;
; ([GenSymBind]
ss2,[Core (M Stmt)]
zs) <- [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss
; Core (M Stmt)
z <- Core (M Pat) -> Core (M Exp) -> MetaM (Core (M Stmt))
repBindSt Core (M Pat)
p1 Core (M Exp)
e2
; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }}
repSts (LetStmt XLetStmt GhcRn GhcRn (LHsExpr GhcRn)
_ HsLocalBinds GhcRn
bs : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
do { ([GenSymBind]
ss1,Core [M Dec]
ds) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
bs
; Core (M Stmt)
z <- Core [M Dec] -> MetaM (Core (M Stmt))
repLetSt Core [M Dec]
ds
; ([GenSymBind]
ss2,[Core (M Stmt)]
zs) <- [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 ([Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss)
; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }
repSts (BodyStmt XBodyStmt GhcRn GhcRn (LHsExpr GhcRn)
_ LHsExpr GhcRn
e SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_ : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
do { Core (M Exp)
e2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
; Core (M Stmt)
z <- Core (M Exp) -> MetaM (Core (M Stmt))
repNoBindSt Core (M Exp)
e2
; ([GenSymBind]
ss2,[Core (M Stmt)]
zs) <- [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss
; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }
repSts (ParStmt XParStmt GhcRn GhcRn (LHsExpr GhcRn)
_ [ParStmtBlock GhcRn GhcRn]
stmt_blocks HsExpr GhcRn
_ SyntaxExpr GhcRn
_ : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
do { ([[GenSymBind]]
ss_s, [Core [M Stmt]]
stmt_blocks1) <- (ParStmtBlock GhcRn GhcRn
-> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt]))
-> [ParStmtBlock GhcRn GhcRn]
-> ReaderT MetaWrappers DsM ([[GenSymBind]], [Core [M Stmt]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM ParStmtBlock GhcRn GhcRn
-> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt])
rep_stmt_block [ParStmtBlock GhcRn GhcRn]
stmt_blocks
; let stmt_blocks2 :: Core [[M Stmt]]
stmt_blocks2 = [Core [M Stmt]] -> Core [[M Stmt]]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core [M Stmt]]
stmt_blocks1
ss1 :: [GenSymBind]
ss1 = [[GenSymBind]] -> [GenSymBind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenSymBind]]
ss_s
; Core (M Stmt)
z <- Core [[M Stmt]] -> MetaM (Core (M Stmt))
repParSt Core [[M Stmt]]
stmt_blocks2
; ([GenSymBind]
ss2, [Core (M Stmt)]
zs) <- [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 ([Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss)
; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }
where
rep_stmt_block :: ParStmtBlock GhcRn GhcRn
-> MetaM ([GenSymBind], Core [(M TH.Stmt)])
rep_stmt_block :: ParStmtBlock GhcRn GhcRn
-> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt])
rep_stmt_block (ParStmtBlock XParStmtBlock GhcRn GhcRn
_ [ExprLStmt GhcRn]
stmts [IdP GhcRn]
_ SyntaxExpr GhcRn
_) =
do { ([GenSymBind]
ss1, [Core (M Stmt)]
zs) <- [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts ((GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc [ExprLStmt GhcRn]
[GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmts)
; Core [M Stmt]
zs1 <- Name -> [Core (M Stmt)] -> MetaM (Core [M Stmt])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
stmtTyConName [Core (M Stmt)]
zs
; ([GenSymBind], Core [M Stmt])
-> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1, Core [M Stmt]
zs1) }
repSts [LastStmt XLastStmt GhcRn GhcRn (LHsExpr GhcRn)
_ LHsExpr GhcRn
e Maybe Bool
_ SyntaxExpr GhcRn
_]
= do { Core (M Exp)
e2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
; Core (M Stmt)
z <- Core (M Exp) -> MetaM (Core (M Stmt))
repNoBindSt Core (M Exp)
e2
; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Core (M Stmt)
z]) }
repSts (stmt :: Stmt GhcRn (LHsExpr GhcRn)
stmt@RecStmt{} : [Stmt GhcRn (LHsExpr GhcRn)]
ss)
= do { let binders :: [IdP GhcRn]
binders = CollectFlag GhcRn
-> [LStmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
-> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders (GenLocated
(Anno
[GenLocated
(Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
[LStmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
-> [LStmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
(Anno
[GenLocated
(Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
[LStmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
-> [LStmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))])
-> GenLocated
(Anno
[GenLocated
(Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
[LStmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
-> [LStmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall a b. (a -> b) -> a -> b
$ StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> XRec
GhcRn [LStmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts Stmt GhcRn (LHsExpr GhcRn)
StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
stmt)
; [GenSymBind]
ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms [IdP GhcRn]
[Name]
binders
; ([GenSymBind]
ss1_other,[Core (M Stmt)]
rss) <- [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 (MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)]))
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a b. (a -> b) -> a -> b
$ [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts ((GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc (GenLocated
(Anno
[GenLocated
(Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
[GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
(Anno
[GenLocated
(Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
[GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
-> GenLocated
(Anno
[GenLocated
(Anno (StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
[GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [GenLocated
SrcSpanAnnA
(StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a b. (a -> b) -> a -> b
$ StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> XRec
GhcRn [LStmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts Stmt GhcRn (LHsExpr GhcRn)
StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
stmt))
; Bool -> ReaderT MetaWrappers DsM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert ([GenSymBind] -> [GenSymBind]
forall a. Ord a => [a] -> [a]
sort [GenSymBind]
ss1 [GenSymBind] -> [GenSymBind] -> Bool
forall a. Eq a => a -> a -> Bool
== [GenSymBind] -> [GenSymBind]
forall a. Ord a => [a] -> [a]
sort [GenSymBind]
ss1_other)
; Core (M Stmt)
z <- Core [M Stmt] -> MetaM (Core (M Stmt))
repRecSt ([Core (M Stmt)] -> Core [M Stmt]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Stmt)]
rss)
; ([GenSymBind]
ss2,[Core (M Stmt)]
zs) <- [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 ([Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss)
; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }
repSts [] = ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
other = ThRejectionReason -> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. ThRejectionReason -> MetaM a
notHandled ([Stmt GhcRn (LHsExpr GhcRn)] -> ThRejectionReason
ThExoticStatement [Stmt GhcRn (LHsExpr GhcRn)]
other)
repBinds :: HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [(M TH.Dec)])
repBinds :: HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds (EmptyLocalBinds XEmptyLocalBinds GhcRn GhcRn
_)
= do { Core [M Dec]
core_list <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName []
; ([GenSymBind], Core [M Dec]) -> MetaM ([GenSymBind], Core [M Dec])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Core [M Dec]
core_list) }
repBinds (HsIPBinds XHsIPBinds GhcRn GhcRn
_ (IPBinds XIPBinds GhcRn
_ [LIPBind GhcRn]
decs))
= do { [(SrcSpan, Core (M Dec))]
ips <- (GenLocated SrcSpanAnnA (IPBind GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (IPBind GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LIPBind GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (IPBind GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_implicit_param_bind [LIPBind GhcRn]
[GenLocated SrcSpanAnnA (IPBind GhcRn)]
decs
; Core [M Dec]
core_list <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName
([(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc [(SrcSpan, Core (M Dec))]
ips))
; ([GenSymBind], Core [M Dec]) -> MetaM ([GenSymBind], Core [M Dec])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Core [M Dec]
core_list)
}
repBinds (HsValBinds XHsValBinds GhcRn GhcRn
_ HsValBinds GhcRn
decs)
= do { let { bndrs :: [Name]
bndrs = HsValBinds GhcRn -> [Name]
hsScopedTvBinders HsValBinds GhcRn
decs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ CollectFlag GhcRn -> HsValBinds GhcRn -> [IdP GhcRn]
forall (idL :: Pass) idR.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR -> [IdP (GhcPass idL)]
collectHsValBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders HsValBinds GhcRn
decs }
; [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
bndrs
; [(SrcSpan, Core (M Dec))]
prs <- [GenSymBind]
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (HsValBinds GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_val_binds HsValBinds GhcRn
decs)
; Core [M Dec]
core_list <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName
([(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc [(SrcSpan, Core (M Dec))]
prs))
; ([GenSymBind], Core [M Dec]) -> MetaM ([GenSymBind], Core [M Dec])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss, Core [M Dec]
core_list) }
rep_implicit_param_bind :: LIPBind GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
rep_implicit_param_bind :: LIPBind GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_implicit_param_bind (L SrcSpanAnnA
loc (IPBind XCIPBind GhcRn
_ (L SrcAnn NoEpAnns
_ HsIPName
n) (L SrcSpanAnnA
_ HsExpr GhcRn
rhs)))
= do { Core String
name <- HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name HsIPName
n
; Core (M Exp)
rhs' <- HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
rhs
; Core (M Dec)
ipb <- Core String -> Core (M Exp) -> MetaM (Core (M Dec))
repImplicitParamBind Core String
name Core (M Exp)
rhs'
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
ipb) }
rep_implicit_param_name :: HsIPName -> MetaM (Core String)
rep_implicit_param_name :: HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name (HsIPName FastString
name) = FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
name
rep_val_binds :: HsValBinds GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_val_binds :: HsValBinds GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_val_binds (XValBindsLR (NValBinds [(RecFlag, LHsBindsLR GhcRn GhcRn)]
binds [LSig GhcRn]
sigs))
= do { [(SrcSpan, Core (M Dec))]
core1 <- LHsBindsLR GhcRn GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_binds ([Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
forall a. [Bag a] -> Bag a
unionManyBags (((RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
-> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))]
-> [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
forall a b. (a, b) -> b
snd [(RecFlag, LHsBindsLR GhcRn GhcRn)]
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))]
binds))
; [(SrcSpan, Core (M Dec))]
core2 <- [LSig GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
rep_sigs [LSig GhcRn]
sigs
; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SrcSpan, Core (M Dec))]
core1 [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
core2) }
rep_val_binds (ValBinds XValBinds GhcRn GhcRn
_ LHsBindsLR GhcRn GhcRn
_ [LSig GhcRn]
_)
= String -> MetaM [(SrcSpan, Core (M Dec))]
forall a. HasCallStack => String -> a
panic String
"rep_val_binds: ValBinds"
rep_binds :: LHsBinds GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_binds :: LHsBindsLR GhcRn GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_binds = (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))]
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 LHsBind GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_bind ([GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
-> MetaM [(SrcSpan, Core (M Dec))])
-> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)])
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
-> MetaM [(SrcSpan, Core (M Dec))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
forall a. Bag a -> [a]
bagToList
rep_bind :: LHsBind GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
rep_bind :: LHsBind GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_bind (L SrcSpanAnnA
loc (FunBind
{ fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = LIdP GhcRn
fn,
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts
= (L SrcSpanAnnL
_ [L SrcSpanAnnA
_ (Match
{ m_pats :: forall p body. Match p body -> [LPat p]
m_pats = []
, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [LGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
guards HsLocalBinds GhcRn
wheres }
)]) } }))
= do { ([GenSymBind]
ss,Core [M Dec]
wherecore) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
wheres
; Core (M Body)
guardcore <- [GenSymBind] -> MetaM (Core (M Body)) -> MetaM (Core (M Body))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss ([LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
[LGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
guards)
; Core Name
fn' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP GhcRn
GenLocated SrcSpanAnnN Name
fn
; Core (M Pat)
p <- Core Name -> MetaM (Core (M Pat))
repPvar Core Name
fn'
; Core (M Dec)
ans <- Core (M Pat)
-> Core (M Body) -> Core [M Dec] -> MetaM (Core (M Dec))
repVal Core (M Pat)
p Core (M Body)
guardcore Core [M Dec]
wherecore
; Core (M Dec)
ans' <- [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
ans
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
ans') }
rep_bind (L SrcSpanAnnA
loc (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = LIdP GhcRn
fn
, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
ms } }))
= do { [Core (M Clause)]
ms1 <- (GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Clause)))
-> [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> ReaderT MetaWrappers DsM [Core (M Clause)]
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 LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Clause))
GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClauseTup [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
ms
; Core Name
fn' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP GhcRn
GenLocated SrcSpanAnnN Name
fn
; Core (M Dec)
ans <- Core Name -> Core [M Clause] -> MetaM (Core (M Dec))
repFun Core Name
fn' ([Core (M Clause)] -> Core [M Clause]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Clause)]
ms1)
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
ans) }
rep_bind (L SrcSpanAnnA
loc (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcRn
pat
, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs = GRHSs XCGRHSs GhcRn (LHsExpr GhcRn)
_ [LGRHS GhcRn (LHsExpr GhcRn)]
guards HsLocalBinds GhcRn
wheres }))
= do { Core (M Pat)
patcore <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
pat
; ([GenSymBind]
ss,Core [M Dec]
wherecore) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
wheres
; Core (M Body)
guardcore <- [GenSymBind] -> MetaM (Core (M Body)) -> MetaM (Core (M Body))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss ([LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
guards)
; Core (M Dec)
ans <- Core (M Pat)
-> Core (M Body) -> Core [M Dec] -> MetaM (Core (M Dec))
repVal Core (M Pat)
patcore Core (M Body)
guardcore Core [M Dec]
wherecore
; Core (M Dec)
ans' <- [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
ans
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
ans') }
rep_bind (L SrcSpanAnnA
_ (VarBind { var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP GhcRn
v, var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs = LHsExpr GhcRn
e}))
= do { Core Name
v' <- Name -> MetaM (Core Name)
lookupBinder IdP GhcRn
Name
v
; Core (M Exp)
e2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
; Core (M Body)
x <- Core (M Exp) -> MetaM (Core (M Body))
repNormal Core (M Exp)
e2
; Core (M Pat)
patcore <- Core Name -> MetaM (Core (M Pat))
repPvar Core Name
v'
; Core [M Dec]
empty_decls <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName []
; Core (M Dec)
ans <- Core (M Pat)
-> Core (M Body) -> Core [M Dec] -> MetaM (Core (M Dec))
repVal Core (M Pat)
patcore Core (M Body)
x Core [M Dec]
empty_decls
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcLoc -> SrcSpan
srcLocSpan (Name -> SrcLoc
forall a. NamedThing a => a -> SrcLoc
getSrcLoc IdP GhcRn
Name
v), Core (M Dec)
ans) }
rep_bind (L SrcSpanAnnA
loc (PatSynBind XPatSynBind GhcRn GhcRn
_ (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id = LIdP GhcRn
syn
, psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_args = HsPatSynDetails GhcRn
args
, psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def = LPat GhcRn
pat
, psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir = HsPatSynDir GhcRn
dir })))
= do { Core Name
syn' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP GhcRn
GenLocated SrcSpanAnnN Name
syn
; Core (M PatSynDir)
dir' <- HsPatSynDir GhcRn -> MetaM (Core (M PatSynDir))
repPatSynDir HsPatSynDir GhcRn
dir
; [GenSymBind]
ss <- HsPatSynDetails GhcRn -> MetaM [GenSymBind]
mkGenArgSyms HsPatSynDetails GhcRn
args
; Core (M Dec)
patSynD' <- [GenSymBind] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (
do { Core (M PatSynArgs)
args' <- HsPatSynDetails GhcRn -> MetaM (Core (M PatSynArgs))
repPatSynArgs HsPatSynDetails GhcRn
args
; Core (M Pat)
pat' <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
pat
; Core Name
-> Core (M PatSynArgs)
-> Core (M PatSynDir)
-> Core (M Pat)
-> MetaM (Core (M Dec))
repPatSynD Core Name
syn' Core (M PatSynArgs)
args' Core (M PatSynDir)
dir' Core (M Pat)
pat' })
; Core (M Dec)
patSynD'' <- HsPatSynDetails GhcRn
-> [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
wrapGenArgSyms HsPatSynDetails GhcRn
args [GenSymBind]
ss Core (M Dec)
patSynD'
; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
patSynD'') }
where
mkGenArgSyms :: HsPatSynDetails GhcRn -> MetaM [GenSymBind]
mkGenArgSyms :: HsPatSynDetails GhcRn -> MetaM [GenSymBind]
mkGenArgSyms (PrefixCon [Void]
_ [LIdP GhcRn]
args) = [Name] -> MetaM [GenSymBind]
mkGenSyms ((GenLocated SrcSpanAnnN Name -> Name)
-> [GenLocated SrcSpanAnnN Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
args)
mkGenArgSyms (InfixCon LIdP GhcRn
arg1 LIdP GhcRn
arg2) = [Name] -> MetaM [GenSymBind]
mkGenSyms [GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
arg1, GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
arg2]
mkGenArgSyms (RecCon [RecordPatSynField GhcRn]
fields)
= do { let pats :: [Name]
pats = (RecordPatSynField GhcRn -> Name)
-> [RecordPatSynField GhcRn] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN Name -> Name)
-> (RecordPatSynField GhcRn -> GenLocated SrcSpanAnnN Name)
-> RecordPatSynField GhcRn
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField GhcRn -> LIdP GhcRn
RecordPatSynField GhcRn -> GenLocated SrcSpanAnnN Name
forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar) [RecordPatSynField GhcRn]
fields
sels :: [Name]
sels = (RecordPatSynField GhcRn -> Name)
-> [RecordPatSynField GhcRn] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (FieldOcc GhcRn -> XCFieldOcc GhcRn
FieldOcc GhcRn -> Name
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt (FieldOcc GhcRn -> Name)
-> (RecordPatSynField GhcRn -> FieldOcc GhcRn)
-> RecordPatSynField GhcRn
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField GhcRn -> FieldOcc GhcRn
forall pass. RecordPatSynField pass -> FieldOcc pass
recordPatSynField) [RecordPatSynField GhcRn]
fields
; [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
sels
; [GenSymBind] -> MetaM [GenSymBind]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind] -> MetaM [GenSymBind])
-> [GenSymBind] -> MetaM [GenSymBind]
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> [GenSymBind] -> [GenSymBind]
forall {a} {a} {b}. Eq a => [(a, a)] -> [(a, b)] -> [(a, b)]
replaceNames ([Name] -> [Name] -> [(Name, Name)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
sels [Name]
pats) [GenSymBind]
ss }
replaceNames :: [(a, a)] -> [(a, b)] -> [(a, b)]
replaceNames [(a, a)]
selsPats [(a, b)]
genSyms
= [ (a
pat, b
id) | (a
sel, b
id) <- [(a, b)]
genSyms, (a
sel', a
pat) <- [(a, a)]
selsPats
, a
sel a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
sel' ]
wrapGenArgSyms :: HsPatSynDetails GhcRn
-> [GenSymBind] -> Core (M TH.Dec) -> MetaM (Core (M TH.Dec))
wrapGenArgSyms :: HsPatSynDetails GhcRn
-> [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
wrapGenArgSyms (RecCon [RecordPatSynField GhcRn]
_) [GenSymBind]
_ Core (M Dec)
dec = Core (M Dec) -> MetaM (Core (M Dec))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Dec)
dec
wrapGenArgSyms HsPatSynDetails GhcRn
_ [GenSymBind]
ss Core (M Dec)
dec = [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
dec
repPatSynD :: Core TH.Name
-> Core (M TH.PatSynArgs)
-> Core (M TH.PatSynDir)
-> Core (M TH.Pat)
-> MetaM (Core (M TH.Dec))
repPatSynD :: Core Name
-> Core (M PatSynArgs)
-> Core (M PatSynDir)
-> Core (M Pat)
-> MetaM (Core (M Dec))
repPatSynD (MkC CoreExpr
syn) (MkC CoreExpr
args) (MkC CoreExpr
dir) (MkC CoreExpr
pat)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
patSynDName [CoreExpr
syn, CoreExpr
args, CoreExpr
dir, CoreExpr
pat]
repPatSynArgs :: HsPatSynDetails GhcRn -> MetaM (Core (M TH.PatSynArgs))
repPatSynArgs :: HsPatSynDetails GhcRn -> MetaM (Core (M PatSynArgs))
repPatSynArgs (PrefixCon [Void]
_ [LIdP GhcRn]
args)
= do { Core [Name]
args' <- Name
-> (GenLocated SrcSpanAnnN Name -> MetaM (Core Name))
-> [GenLocated SrcSpanAnnN Name]
-> MetaM (Core [Name])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
nameTyConName GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
args
; Core [Name] -> MetaM (Core (M PatSynArgs))
repPrefixPatSynArgs Core [Name]
args' }
repPatSynArgs (InfixCon LIdP GhcRn
arg1 LIdP GhcRn
arg2)
= do { Core Name
arg1' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
arg1
; Core Name
arg2' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP GhcRn
GenLocated SrcSpanAnnN Name
arg2
; Core Name -> Core Name -> MetaM (Core (M PatSynArgs))
repInfixPatSynArgs Core Name
arg1' Core Name
arg2' }
repPatSynArgs (RecCon [RecordPatSynField GhcRn]
fields)
= do { Core [Name]
sels' <- Name
-> (FieldOcc GhcRn -> MetaM (Core Name))
-> [FieldOcc GhcRn]
-> MetaM (Core [Name])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
nameTyConName (Name -> MetaM (Core Name)
lookupOcc (Name -> MetaM (Core Name))
-> (FieldOcc GhcRn -> Name) -> FieldOcc GhcRn -> MetaM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc GhcRn -> XCFieldOcc GhcRn
FieldOcc GhcRn -> Name
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt) [FieldOcc GhcRn]
sels
; Core [Name] -> MetaM (Core (M PatSynArgs))
repRecordPatSynArgs Core [Name]
sels' }
where sels :: [FieldOcc GhcRn]
sels = (RecordPatSynField GhcRn -> FieldOcc GhcRn)
-> [RecordPatSynField GhcRn] -> [FieldOcc GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map RecordPatSynField GhcRn -> FieldOcc GhcRn
forall pass. RecordPatSynField pass -> FieldOcc pass
recordPatSynField [RecordPatSynField GhcRn]
fields
repPrefixPatSynArgs :: Core [TH.Name] -> MetaM (Core (M TH.PatSynArgs))
repPrefixPatSynArgs :: Core [Name] -> MetaM (Core (M PatSynArgs))
repPrefixPatSynArgs (MkC CoreExpr
nms) = Name -> [CoreExpr] -> MetaM (Core (M PatSynArgs))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
prefixPatSynName [CoreExpr
nms]
repInfixPatSynArgs :: Core TH.Name -> Core TH.Name -> MetaM (Core (M TH.PatSynArgs))
repInfixPatSynArgs :: Core Name -> Core Name -> MetaM (Core (M PatSynArgs))
repInfixPatSynArgs (MkC CoreExpr
nm1) (MkC CoreExpr
nm2) = Name -> [CoreExpr] -> MetaM (Core (M PatSynArgs))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixPatSynName [CoreExpr
nm1, CoreExpr
nm2]
repRecordPatSynArgs :: Core [TH.Name]
-> MetaM (Core (M TH.PatSynArgs))
repRecordPatSynArgs :: Core [Name] -> MetaM (Core (M PatSynArgs))
repRecordPatSynArgs (MkC CoreExpr
sels) = Name -> [CoreExpr] -> MetaM (Core (M PatSynArgs))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recordPatSynName [CoreExpr
sels]
repPatSynDir :: HsPatSynDir GhcRn -> MetaM (Core (M TH.PatSynDir))
repPatSynDir :: HsPatSynDir GhcRn -> MetaM (Core (M PatSynDir))
repPatSynDir HsPatSynDir GhcRn
Unidirectional = Name -> [CoreExpr] -> MetaM (Core (M PatSynDir))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unidirPatSynName []
repPatSynDir HsPatSynDir GhcRn
ImplicitBidirectional = Name -> [CoreExpr] -> MetaM (Core (M PatSynDir))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
implBidirPatSynName []
repPatSynDir (ExplicitBidirectional (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
clauses) }))
= do { [Core (M Clause)]
clauses' <- (GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Clause)))
-> [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> ReaderT MetaWrappers DsM [Core (M Clause)]
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 LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Clause))
GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClauseTup [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
clauses
; Core [M Clause] -> MetaM (Core (M PatSynDir))
repExplBidirPatSynDir ([Core (M Clause)] -> Core [M Clause]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Clause)]
clauses') }
repExplBidirPatSynDir :: Core [(M TH.Clause)] -> MetaM (Core (M TH.PatSynDir))
repExplBidirPatSynDir :: Core [M Clause] -> MetaM (Core (M PatSynDir))
repExplBidirPatSynDir (MkC CoreExpr
cls) = Name -> [CoreExpr] -> MetaM (Core (M PatSynDir))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
explBidirPatSynName [CoreExpr
cls]
repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Exp))
repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M Exp))
repLambda (L SrcSpanAnnA
_ (Match { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcRn]
ps
, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [L SrcAnn NoEpAnns
_ (GRHS XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [] GenLocated SrcSpanAnnA (HsExpr GhcRn)
e)]
(EmptyLocalBinds XEmptyLocalBinds GhcRn GhcRn
_) } ))
= do { let bndrs :: [IdP GhcRn]
bndrs = CollectFlag GhcRn -> [LPat GhcRn] -> [IdP GhcRn]
forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders [LPat GhcRn]
ps ;
; [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [IdP GhcRn]
[Name]
bndrs
; Core (M Exp)
lam <- [GenSymBind] -> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (
do { Core [M Pat]
xs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps; Core (M Exp)
body <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e; Core [M Pat] -> Core (M Exp) -> MetaM (Core (M Exp))
repLam Core [M Pat]
xs Core (M Exp)
body })
; [GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
lam }
repLambda (L SrcSpanAnnA
_ Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
m) = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (Match GhcRn (LHsExpr GhcRn) -> ThRejectionReason
ThGuardedLambdas Match GhcRn (LHsExpr GhcRn)
Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
m)
repLPs :: [LPat GhcRn] -> MetaM (Core [(M TH.Pat)])
repLPs :: [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps = Name
-> (GenLocated SrcSpanAnnA (Pat GhcRn) -> MetaM (Core (M Pat)))
-> [GenLocated SrcSpanAnnA (Pat GhcRn)]
-> MetaM (Core [M Pat])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
patTyConName LPat GhcRn -> MetaM (Core (M Pat))
GenLocated SrcSpanAnnA (Pat GhcRn) -> MetaM (Core (M Pat))
repLP [LPat GhcRn]
[GenLocated SrcSpanAnnA (Pat GhcRn)]
ps
repLP :: LPat GhcRn -> MetaM (Core (M TH.Pat))
repLP :: LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p = Pat GhcRn -> MetaM (Core (M Pat))
repP (GenLocated SrcSpanAnnA (Pat GhcRn) -> Pat GhcRn
forall l e. GenLocated l e -> e
unLoc LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
p)
repP :: Pat GhcRn -> MetaM (Core (M TH.Pat))
repP :: Pat GhcRn -> MetaM (Core (M Pat))
repP (WildPat XWildPat GhcRn
_) = MetaM (Core (M Pat))
repPwild
repP (LitPat XLitPat GhcRn
_ HsLit GhcRn
l) = do { Core Lit
l2 <- HsLit GhcRn -> MetaM (Core Lit)
repLiteral HsLit GhcRn
l; Core Lit -> MetaM (Core (M Pat))
repPlit Core Lit
l2 }
repP (VarPat XVarPat GhcRn
_ LIdP GhcRn
x) = do { Core Name
x' <- Name -> MetaM (Core Name)
lookupBinder (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
x); Core Name -> MetaM (Core (M Pat))
repPvar Core Name
x' }
repP (LazyPat XLazyPat GhcRn
_ LPat GhcRn
p) = do { Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p; Core (M Pat) -> MetaM (Core (M Pat))
repPtilde Core (M Pat)
p1 }
repP (BangPat XBangPat GhcRn
_ LPat GhcRn
p) = do { Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p; Core (M Pat) -> MetaM (Core (M Pat))
repPbang Core (M Pat)
p1 }
repP (AsPat XAsPat GhcRn
_ LIdP GhcRn
x LHsToken "@" GhcRn
_ LPat GhcRn
p) = do { Core Name
x' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP GhcRn
GenLocated SrcSpanAnnN Name
x; Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
; Core Name -> Core (M Pat) -> MetaM (Core (M Pat))
repPaspat Core Name
x' Core (M Pat)
p1 }
repP (ParPat XParPat GhcRn
_ LHsToken "(" GhcRn
_ LPat GhcRn
p LHsToken ")" GhcRn
_) = LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
repP (ListPat XListPat GhcRn
_ [LPat GhcRn]
ps) = do { Core [M Pat]
qs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps; Core [M Pat] -> MetaM (Core (M Pat))
repPlist Core [M Pat]
qs }
repP (TuplePat XTuplePat GhcRn
_ [LPat GhcRn]
ps Boxity
boxed)
| Boxity -> Bool
isBoxed Boxity
boxed = do { Core [M Pat]
qs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps; Core [M Pat] -> MetaM (Core (M Pat))
repPtup Core [M Pat]
qs }
| Bool
otherwise = do { Core [M Pat]
qs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps; Core [M Pat] -> MetaM (Core (M Pat))
repPunboxedTup Core [M Pat]
qs }
repP (SumPat XSumPat GhcRn
_ LPat GhcRn
p Int
alt Int
arity) = do { Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
; Core (M Pat) -> Int -> Int -> MetaM (Core (M Pat))
repPunboxedSum Core (M Pat)
p1 Int
alt Int
arity }
repP (ConPat XConPat GhcRn
NoExtField
NoExtField XRec GhcRn (ConLikeP GhcRn)
dc HsConPatDetails GhcRn
details)
= do { Core Name
con_str <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc XRec GhcRn (ConLikeP GhcRn)
GenLocated SrcSpanAnnN Name
dc
; case HsConPatDetails GhcRn
details of
PrefixCon [HsConPatTyArg (NoGhcTc GhcRn)]
tyargs [LPat GhcRn]
ps -> do { Core [M Pat]
qs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps
; let unwrapTyArg :: HsConPatTyArg pass -> HsType pass
unwrapTyArg (HsConPatTyArg LHsToken "@" pass
_ HsPatSigType pass
t) = GenLocated l (HsType pass) -> HsType pass
forall l e. GenLocated l e -> e
unLoc (HsPatSigType pass -> XRec pass (HsType pass)
forall pass. HsPatSigType pass -> LHsType pass
hsps_body HsPatSigType pass
t)
; Core [M Type]
ts <- Name
-> (HsConPatTyArg GhcRn -> MetaM (Core (M Type)))
-> [HsConPatTyArg GhcRn]
-> MetaM (Core [M Type])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
typeTyConName (HsType GhcRn -> MetaM (Core (M Type))
repTy (HsType GhcRn -> MetaM (Core (M Type)))
-> (HsConPatTyArg GhcRn -> HsType GhcRn)
-> HsConPatTyArg GhcRn
-> MetaM (Core (M Type))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsConPatTyArg GhcRn -> HsType GhcRn
forall {pass} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
HsConPatTyArg pass -> HsType pass
unwrapTyArg) [HsConPatTyArg (NoGhcTc GhcRn)]
[HsConPatTyArg GhcRn]
tyargs
; Core Name -> Core [M Type] -> Core [M Pat] -> MetaM (Core (M Pat))
repPcon Core Name
con_str Core [M Type]
ts Core [M Pat]
qs }
RecCon HsRecFields GhcRn (LPat GhcRn)
rec -> do { Core [M (Name, Pat)]
fps <- Name
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (Pat GhcRn)))
-> MetaM (Core (M (Name, Pat))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (Pat GhcRn)))]
-> MetaM (Core [M (Name, Pat)])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
fieldPatTyConName LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (Name, Pat)))
GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (Pat GhcRn)))
-> MetaM (Core (M (Name, Pat)))
rep_fld (HsRecFields GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn))
-> [LHsRecField GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn))]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields GhcRn (LPat GhcRn)
HsRecFields GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn))
rec)
; Core Name -> Core [M (Name, Pat)] -> MetaM (Core (M Pat))
repPrec Core Name
con_str Core [M (Name, Pat)]
fps }
InfixCon LPat GhcRn
p1 LPat GhcRn
p2 -> do { Core (M Pat)
p1' <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p1;
Core (M Pat)
p2' <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p2;
Core (M Pat) -> Core Name -> Core (M Pat) -> MetaM (Core (M Pat))
repPinfix Core (M Pat)
p1' Core Name
con_str Core (M Pat)
p2' }
}
where
rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (TH.Name, TH.Pat)))
rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (Name, Pat)))
rep_fld (L SrcSpanAnnA
_ HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (Pat GhcRn))
fld) = do { MkC CoreExpr
v <- Name -> MetaM (Core Name)
lookupOcc (HsRecField GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn))
-> XCFieldOcc GhcRn
forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
hsRecFieldSel HsRecField GhcRn (GenLocated SrcSpanAnnA (Pat GhcRn))
HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (Pat GhcRn))
fld)
; MkC CoreExpr
p <- LPat GhcRn -> MetaM (Core (M Pat))
repLP (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (Pat GhcRn))
-> GenLocated SrcSpanAnnA (Pat GhcRn)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
(GenLocated SrcSpanAnnA (Pat GhcRn))
fld)
; Name -> [CoreExpr] -> MetaM (Core (M (Name, Pat)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fieldPatName [CoreExpr
v,CoreExpr
p] }
repP (NPat XNPat GhcRn
_ (L SrcAnn NoEpAnns
_ HsOverLit GhcRn
l) Maybe (SyntaxExpr GhcRn)
Nothing SyntaxExpr GhcRn
_) = do { Core Lit
a <- HsOverLit GhcRn -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit GhcRn
l
; Core Lit -> MetaM (Core (M Pat))
repPlit Core Lit
a }
repP (ViewPat XViewPat GhcRn
_ LHsExpr GhcRn
e LPat GhcRn
p) = do { Core (M Exp)
e' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e; Core (M Pat)
p' <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p; Core (M Exp) -> Core (M Pat) -> MetaM (Core (M Pat))
repPview Core (M Exp)
e' Core (M Pat)
p' }
repP p :: Pat GhcRn
p@(NPat XNPat GhcRn
_ (L SrcAnn NoEpAnns
_ HsOverLit GhcRn
l) (Just SyntaxExpr GhcRn
_) SyntaxExpr GhcRn
_)
| OverLitRn Bool
rebindable LIdP GhcRn
_ <- HsOverLit GhcRn -> XOverLit GhcRn
forall p. HsOverLit p -> XOverLit p
ol_ext HsOverLit GhcRn
l
, Bool
rebindable = ThRejectionReason -> MetaM (Core (M Pat))
forall a. ThRejectionReason -> MetaM a
notHandled (Pat GhcRn -> ThRejectionReason
ThNegativeOverloadedPatterns Pat GhcRn
p)
| HsIntegral IntegralLit
i <- HsOverLit GhcRn -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcRn
l = do { Core Lit
a <- HsOverLit GhcRn -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit GhcRn
l{ol_val = HsIntegral (negateIntegralLit i)}
; Core Lit -> MetaM (Core (M Pat))
repPlit Core Lit
a }
| HsFractional FractionalLit
i <- HsOverLit GhcRn -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcRn
l = do { Core Lit
a <- HsOverLit GhcRn -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit GhcRn
l{ol_val = HsFractional (negateFractionalLit i)}
; Core Lit -> MetaM (Core (M Pat))
repPlit Core Lit
a }
| Bool
otherwise = ThRejectionReason -> MetaM (Core (M Pat))
forall a. ThRejectionReason -> MetaM a
notHandled (Pat GhcRn -> ThRejectionReason
ThExoticPattern Pat GhcRn
p)
repP (SigPat XSigPat GhcRn
_ LPat GhcRn
p HsPatSigType (NoGhcTc GhcRn)
t) = do { Core (M Pat)
p' <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
; Core (M Type)
t' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy (HsPatSigType GhcRn -> XRec GhcRn (HsType GhcRn)
forall pass. HsPatSigType pass -> LHsType pass
hsPatSigType HsPatSigType (NoGhcTc GhcRn)
HsPatSigType GhcRn
t)
; Core (M Pat) -> Core (M Type) -> MetaM (Core (M Pat))
repPsig Core (M Pat)
p' Core (M Type)
t' }
repP (SplicePat (HsUntypedSpliceNested Name
n) HsUntypedSplice GhcRn
_) = Name -> MetaM (Core (M Pat))
forall a. Name -> MetaM (Core a)
rep_splice Name
n
repP p :: Pat GhcRn
p@(SplicePat (HsUntypedSpliceTop ThModFinalizers
_ Pat GhcRn
_) HsUntypedSplice GhcRn
_) = String -> SDoc -> MetaM (Core (M Pat))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repP: top level splice" (Pat GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcRn
p)
repP Pat GhcRn
other = ThRejectionReason -> MetaM (Core (M Pat))
forall a. ThRejectionReason -> MetaM a
notHandled (Pat GhcRn -> ThRejectionReason
ThExoticPattern Pat GhcRn
other)
sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc :: forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc = ((SrcSpan, a) -> (SrcSpan, a) -> Ordering)
-> [(SrcSpan, a)] -> [(SrcSpan, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> ((SrcSpan, a) -> SrcSpan)
-> (SrcSpan, a)
-> (SrcSpan, a)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (SrcSpan, a) -> SrcSpan
forall a b. (a, b) -> a
fst)
de_loc :: [(a, b)] -> [b]
de_loc :: forall a b. [(a, b)] -> [b]
de_loc = ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd
type GenSymBind = (Name, Id)
mkGenSyms :: [Name] -> MetaM [GenSymBind]
mkGenSyms :: [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
ns = do { Type
var_ty <- Name -> MetaM Type
lookupType Name
nameTyConName
; [GenSymBind] -> MetaM [GenSymBind]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return [ (Name
nm, (() :: Constraint) => Name -> Type -> Type -> Id
Name -> Type -> Type -> Id
mkLocalId (Name -> Name
localiseName Name
nm) Type
ManyTy Type
var_ty)
| Name
nm <- [Name]
ns] }
addBinds :: [GenSymBind] -> MetaM a -> MetaM a
addBinds :: forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
bs MetaM a
m = (IOEnv (Env DsGblEnv DsLclEnv) a
-> IOEnv (Env DsGblEnv DsLclEnv) a)
-> MetaM a -> MetaM a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (DsMetaEnv
-> IOEnv (Env DsGblEnv DsLclEnv) a
-> IOEnv (Env DsGblEnv DsLclEnv) a
forall a. DsMetaEnv -> DsM a -> DsM a
dsExtendMetaEnv ([(Name, DsMetaVal)] -> DsMetaEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name
n,Id -> DsMetaVal
DsBound Id
id) | (Name
n,Id
id) <- [GenSymBind]
bs])) MetaM a
m
lookupNBinder :: LocatedN Name -> MetaM (Core TH.Name)
lookupNBinder :: GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder GenLocated SrcSpanAnnN Name
n = Name -> MetaM (Core Name)
lookupBinder (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN Name
n)
lookupBinder :: Name -> MetaM (Core TH.Name)
lookupBinder :: Name -> MetaM (Core Name)
lookupBinder = Name -> MetaM (Core Name)
lookupOcc
lookupLOcc :: GenLocated l Name -> MetaM (Core TH.Name)
lookupLOcc :: forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated l Name
n = Name -> MetaM (Core Name)
lookupOcc (GenLocated l Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated l Name
n)
lookupOcc :: Name -> MetaM (Core TH.Name)
lookupOcc :: Name -> MetaM (Core Name)
lookupOcc = DsM (Core Name) -> MetaM (Core Name)
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM (Core Name) -> MetaM (Core Name))
-> (Name -> DsM (Core Name)) -> Name -> MetaM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> DsM (Core Name)
lookupOccDsM
lookupOccDsM :: Name -> DsM (Core TH.Name)
lookupOccDsM :: Name -> DsM (Core Name)
lookupOccDsM Name
n
= do { Maybe DsMetaVal
mb_val <- Name -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
dsLookupMetaEnv Name
n ;
case Maybe DsMetaVal
mb_val of
Maybe DsMetaVal
Nothing -> Name -> DsM (Core Name)
globalVar Name
n
Just (DsBound Id
x) -> Core Name -> DsM (Core Name)
forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Core Name
coreVar Id
x)
Just (DsSplice HsExpr GhcTc
_) -> String -> SDoc -> DsM (Core Name)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repE:lookupOcc" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
}
globalVar :: Name -> DsM (Core TH.Name)
globalVar :: Name -> DsM (Core Name)
globalVar Name
n =
case Name -> Maybe Module
nameModule_maybe Name
n of
Just Module
m -> Module -> OccName -> DsM (Core Name)
globalVarExternal Module
m (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
n)
Maybe Module
Nothing -> Unique -> OccName -> DsM (Core Name)
globalVarLocal (Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique Name
n) (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
n)
globalVarLocal :: Unique -> OccName -> DsM (Core TH.Name)
globalVarLocal :: Unique -> OccName -> DsM (Core Name)
globalVarLocal Unique
unique OccName
name
= do { MkC CoreExpr
occ <- OccName -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
forall (m :: * -> *). MonadThings m => OccName -> m (Core String)
occNameLit OccName
name
; Platform
platform <- DynFlags -> Platform
targetPlatform (DynFlags -> Platform)
-> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
-> IOEnv (Env DsGblEnv DsLclEnv) Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; let uni :: CoreExpr
uni = Platform -> Integer -> CoreExpr
mkIntegerExpr Platform
platform (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Unique -> Int
getKey Unique
unique)
; Name -> [CoreExpr] -> DsM (Core Name)
forall a. NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2_nwDsM Name
mkNameLName [CoreExpr
occ,CoreExpr
uni] }
globalVarExternal :: Module -> OccName -> DsM (Core TH.Name)
globalVarExternal :: Module -> OccName -> DsM (Core Name)
globalVarExternal Module
mod OccName
name_occ
= do {
; MkC CoreExpr
mod <- FastString -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
name_mod
; MkC CoreExpr
pkg <- FastString -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
name_pkg
; MkC CoreExpr
occ <- OccName -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
forall (m :: * -> *). MonadThings m => OccName -> m (Core String)
occNameLit OccName
name_occ
; Name -> [CoreExpr] -> DsM (Core Name)
forall a. NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2_nwDsM Name
mk_varg [CoreExpr
pkg,CoreExpr
mod,CoreExpr
occ] }
where
name_mod :: FastString
name_mod = ModuleName -> FastString
moduleNameFS (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
name_pkg :: FastString
name_pkg = Unit -> FastString
forall u. IsUnitId u => u -> FastString
unitFS (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod)
mk_varg :: Name
mk_varg | OccName -> Bool
isDataOcc OccName
name_occ = Name
mkNameG_dName
| OccName -> Bool
isVarOcc OccName
name_occ = Name
mkNameG_vName
| OccName -> Bool
isTcOcc OccName
name_occ = Name
mkNameG_tcName
| Bool
otherwise = String -> SDoc -> Name
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"GHC.HsToCore.Quote.globalVar" (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name_occ)
lookupType :: Name
-> MetaM Type
lookupType :: Name -> MetaM Type
lookupType Name
tc_name = do { TyCon
tc <- DsM TyCon -> ReaderT MetaWrappers DsM TyCon
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM TyCon -> ReaderT MetaWrappers DsM TyCon)
-> DsM TyCon -> ReaderT MetaWrappers DsM TyCon
forall a b. (a -> b) -> a -> b
$ Name -> DsM TyCon
dsLookupTyCon Name
tc_name ;
Type -> MetaM Type
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> [Type] -> Type
mkTyConApp TyCon
tc []) }
wrapGenSyms :: [GenSymBind]
-> Core (M a) -> MetaM (Core (M a))
wrapGenSyms :: forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
binds body :: Core (M a)
body@(MkC CoreExpr
b)
= do { Type
var_ty <- Name -> MetaM Type
lookupType Name
nameTyConName
; Type -> [GenSymBind] -> MetaM (Core (M a))
go Type
var_ty [GenSymBind]
binds }
where
(Type
_, Type
elt_ty) = Type -> (Type, Type)
tcSplitAppTy ((() :: Constraint) => CoreExpr -> Type
CoreExpr -> Type
exprType CoreExpr
b)
go :: Type -> [GenSymBind] -> MetaM (Core (M a))
go Type
_ [] = Core (M a) -> MetaM (Core (M a))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M a)
body
go Type
var_ty ((Name
name,Id
id) : [GenSymBind]
binds)
= do { MkC CoreExpr
body' <- Type -> [GenSymBind] -> MetaM (Core (M a))
go Type
var_ty [GenSymBind]
binds
; Core String
lit_str <- OccName -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *). MonadThings m => OccName -> m (Core String)
occNameLit (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name)
; Core (M Name)
gensym_app <- Core String -> MetaM (Core (M Name))
repGensym Core String
lit_str
; Type
-> Type
-> Core (M Name)
-> Core (Name -> M a)
-> MetaM (Core (M a))
forall a b.
Type -> Type -> Core (M a) -> Core (a -> M b) -> MetaM (Core (M b))
repBindM Type
var_ty Type
elt_ty
Core (M Name)
gensym_app (CoreExpr -> Core (Name -> M a)
forall a. CoreExpr -> Core a
MkC (Id -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam Id
id CoreExpr
body')) }
occNameLit :: MonadThings m => OccName -> m (Core String)
occNameLit :: forall (m :: * -> *). MonadThings m => OccName -> m (Core String)
occNameLit OccName
name = FastString -> m (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit (OccName -> FastString
occNameFS OccName
name)
newtype Core a = MkC CoreExpr
unC :: Core a -> CoreExpr
unC :: forall a. Core a -> CoreExpr
unC (MkC CoreExpr
x) = CoreExpr
x
type family NotM a where
NotM (M _) = TypeError ('Text ("rep2_nw must not produce something of overloaded type"))
NotM _other = (() :: Constraint)
rep2M :: Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 :: Name -> [CoreExpr] -> MetaM (Core (M a))
rep2_nw :: NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nwDsM :: NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2 :: forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 = (forall z. DsM z -> ReaderT MetaWrappers DsM z)
-> ReaderT MetaWrappers DsM (CoreExpr -> CoreExpr)
-> Name
-> [CoreExpr]
-> ReaderT MetaWrappers DsM (Core (M a))
forall (m :: * -> *) a.
Monad m =>
(forall z. DsM z -> m z)
-> m (CoreExpr -> CoreExpr) -> Name -> [CoreExpr] -> m (Core a)
rep2X IOEnv (Env DsGblEnv DsLclEnv) z -> ReaderT MetaWrappers DsM z
forall z. DsM z -> ReaderT MetaWrappers DsM z
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((MetaWrappers -> CoreExpr -> CoreExpr)
-> ReaderT MetaWrappers DsM (CoreExpr -> CoreExpr)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks MetaWrappers -> CoreExpr -> CoreExpr
quoteWrapper)
rep2M :: forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2M = (forall z. DsM z -> ReaderT MetaWrappers DsM z)
-> ReaderT MetaWrappers DsM (CoreExpr -> CoreExpr)
-> Name
-> [CoreExpr]
-> ReaderT MetaWrappers DsM (Core (M a))
forall (m :: * -> *) a.
Monad m =>
(forall z. DsM z -> m z)
-> m (CoreExpr -> CoreExpr) -> Name -> [CoreExpr] -> m (Core a)
rep2X IOEnv (Env DsGblEnv DsLclEnv) z -> ReaderT MetaWrappers DsM z
forall z. DsM z -> ReaderT MetaWrappers DsM z
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((MetaWrappers -> CoreExpr -> CoreExpr)
-> ReaderT MetaWrappers DsM (CoreExpr -> CoreExpr)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks MetaWrappers -> CoreExpr -> CoreExpr
monadWrapper)
rep2_nw :: forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
n [CoreExpr]
xs = DsM (Core a) -> ReaderT MetaWrappers DsM (Core a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Name -> [CoreExpr] -> DsM (Core a)
forall a. NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2_nwDsM Name
n [CoreExpr]
xs)
rep2_nwDsM :: forall a. NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2_nwDsM = (forall z. DsM z -> DsM z)
-> DsM (CoreExpr -> CoreExpr)
-> Name
-> [CoreExpr]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core a)
forall (m :: * -> *) a.
Monad m =>
(forall z. DsM z -> m z)
-> m (CoreExpr -> CoreExpr) -> Name -> [CoreExpr] -> m (Core a)
rep2X DsM z -> DsM z
forall a. a -> a
forall z. DsM z -> DsM z
id ((CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr -> CoreExpr
forall a. a -> a
id)
rep2X :: Monad m => (forall z . DsM z -> m z)
-> m (CoreExpr -> CoreExpr)
-> Name
-> [ CoreExpr ]
-> m (Core a)
rep2X :: forall (m :: * -> *) a.
Monad m =>
(forall z. DsM z -> m z)
-> m (CoreExpr -> CoreExpr) -> Name -> [CoreExpr] -> m (Core a)
rep2X forall z. DsM z -> m z
lift_dsm m (CoreExpr -> CoreExpr)
get_wrap Name
n [CoreExpr]
xs = do
{ Id
rep_id <- DsM Id -> m Id
forall z. DsM z -> m z
lift_dsm (DsM Id -> m Id) -> DsM Id -> m Id
forall a b. (a -> b) -> a -> b
$ Name -> DsM Id
dsLookupGlobalId Name
n
; CoreExpr -> CoreExpr
wrap <- m (CoreExpr -> CoreExpr)
get_wrap
; Core a -> m (Core a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core a
forall a. CoreExpr -> Core a
MkC (CoreExpr -> Core a) -> CoreExpr -> Core a
forall a b. (a -> b) -> a -> b
$ ((CoreExpr -> CoreExpr -> CoreExpr)
-> CoreExpr -> [CoreExpr] -> CoreExpr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (CoreExpr -> CoreExpr
wrap (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
rep_id)) [CoreExpr]
xs)) }
dataCon' :: Name -> [CoreExpr] -> MetaM (Core a)
dataCon' :: forall a. Name -> [CoreExpr] -> MetaM (Core a)
dataCon' Name
n [CoreExpr]
args = do { DataCon
id <- IOEnv (Env DsGblEnv DsLclEnv) DataCon
-> ReaderT MetaWrappers DsM DataCon
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env DsGblEnv DsLclEnv) DataCon
-> ReaderT MetaWrappers DsM DataCon)
-> IOEnv (Env DsGblEnv DsLclEnv) DataCon
-> ReaderT MetaWrappers DsM DataCon
forall a b. (a -> b) -> a -> b
$ Name -> IOEnv (Env DsGblEnv DsLclEnv) DataCon
dsLookupDataCon Name
n
; Core a -> MetaM (Core a)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Core a -> MetaM (Core a)) -> Core a -> MetaM (Core a)
forall a b. (a -> b) -> a -> b
$ CoreExpr -> Core a
forall a. CoreExpr -> Core a
MkC (CoreExpr -> Core a) -> CoreExpr -> Core a
forall a b. (a -> b) -> a -> b
$ DataCon -> [CoreExpr] -> CoreExpr
mkCoreConApps DataCon
id [CoreExpr]
args }
dataCon :: Name -> MetaM (Core a)
dataCon :: forall a. Name -> MetaM (Core a)
dataCon Name
n = Name -> [CoreExpr] -> MetaM (Core a)
forall a. Name -> [CoreExpr] -> MetaM (Core a)
dataCon' Name
n []
repPlit :: Core TH.Lit -> MetaM (Core (M TH.Pat))
repPlit :: Core Lit -> MetaM (Core (M Pat))
repPlit (MkC CoreExpr
l) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
litPName [CoreExpr
l]
repPvar :: Core TH.Name -> MetaM (Core (M TH.Pat))
repPvar :: Core Name -> MetaM (Core (M Pat))
repPvar (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
varPName [CoreExpr
s]
repPtup :: Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
repPtup :: Core [M Pat] -> MetaM (Core (M Pat))
repPtup (MkC CoreExpr
ps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tupPName [CoreExpr
ps]
repPunboxedTup :: Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
repPunboxedTup :: Core [M Pat] -> MetaM (Core (M Pat))
repPunboxedTup (MkC CoreExpr
ps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedTupPName [CoreExpr
ps]
repPunboxedSum :: Core (M TH.Pat) -> TH.SumAlt -> TH.SumArity -> MetaM (Core (M TH.Pat))
repPunboxedSum :: Core (M Pat) -> Int -> Int -> MetaM (Core (M Pat))
repPunboxedSum (MkC CoreExpr
p) Int
alt Int
arity
= do { Platform
platform <- MetaM Platform
getPlatform
; Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedSumPName [ CoreExpr
p
, Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
alt
, Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
arity ] }
repPcon :: Core TH.Name -> Core [(M TH.Type)] -> Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
repPcon :: Core Name -> Core [M Type] -> Core [M Pat] -> MetaM (Core (M Pat))
repPcon (MkC CoreExpr
s) (MkC CoreExpr
ts) (MkC CoreExpr
ps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
conPName [CoreExpr
s, CoreExpr
ts, CoreExpr
ps]
repPrec :: Core TH.Name -> Core [M (TH.Name, TH.Pat)] -> MetaM (Core (M TH.Pat))
repPrec :: Core Name -> Core [M (Name, Pat)] -> MetaM (Core (M Pat))
repPrec (MkC CoreExpr
c) (MkC CoreExpr
rps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recPName [CoreExpr
c,CoreExpr
rps]
repPinfix :: Core (M TH.Pat) -> Core TH.Name -> Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPinfix :: Core (M Pat) -> Core Name -> Core (M Pat) -> MetaM (Core (M Pat))
repPinfix (MkC CoreExpr
p1) (MkC CoreExpr
n) (MkC CoreExpr
p2) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixPName [CoreExpr
p1, CoreExpr
n, CoreExpr
p2]
repPtilde :: Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPtilde :: Core (M Pat) -> MetaM (Core (M Pat))
repPtilde (MkC CoreExpr
p) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tildePName [CoreExpr
p]
repPbang :: Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPbang :: Core (M Pat) -> MetaM (Core (M Pat))
repPbang (MkC CoreExpr
p) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
bangPName [CoreExpr
p]
repPaspat :: Core TH.Name -> Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPaspat :: Core Name -> Core (M Pat) -> MetaM (Core (M Pat))
repPaspat (MkC CoreExpr
s) (MkC CoreExpr
p) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
asPName [CoreExpr
s, CoreExpr
p]
repPwild :: MetaM (Core (M TH.Pat))
repPwild :: MetaM (Core (M Pat))
repPwild = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
wildPName []
repPlist :: Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
repPlist :: Core [M Pat] -> MetaM (Core (M Pat))
repPlist (MkC CoreExpr
ps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
listPName [CoreExpr
ps]
repPview :: Core (M TH.Exp) -> Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPview :: Core (M Exp) -> Core (M Pat) -> MetaM (Core (M Pat))
repPview (MkC CoreExpr
e) (MkC CoreExpr
p) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
viewPName [CoreExpr
e,CoreExpr
p]
repPsig :: Core (M TH.Pat) -> Core (M TH.Type) -> MetaM (Core (M TH.Pat))
repPsig :: Core (M Pat) -> Core (M Type) -> MetaM (Core (M Pat))
repPsig (MkC CoreExpr
p) (MkC CoreExpr
t) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sigPName [CoreExpr
p, CoreExpr
t]
repVarOrCon :: Name -> Core TH.Name -> MetaM (Core (M TH.Exp))
repVarOrCon :: Name -> Core Name -> MetaM (Core (M Exp))
repVarOrCon Name
vc Core Name
str
| NameSpace -> Bool
isVarNameSpace NameSpace
ns = Core Name -> MetaM (Core (M Exp))
repVar Core Name
str
| Bool
otherwise = Core Name -> MetaM (Core (M Exp))
repCon Core Name
str
where
ns :: NameSpace
ns = Name -> NameSpace
nameNameSpace Name
vc
repVar :: Core TH.Name -> MetaM (Core (M TH.Exp))
repVar :: Core Name -> MetaM (Core (M Exp))
repVar (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
varEName [CoreExpr
s]
repCon :: Core TH.Name -> MetaM (Core (M TH.Exp))
repCon :: Core Name -> MetaM (Core (M Exp))
repCon (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
conEName [CoreExpr
s]
repLit :: Core TH.Lit -> MetaM (Core (M TH.Exp))
repLit :: Core Lit -> MetaM (Core (M Exp))
repLit (MkC CoreExpr
c) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
litEName [CoreExpr
c]
repApp :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repApp :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repApp (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
appEName [CoreExpr
x,CoreExpr
y]
repAppType :: Core (M TH.Exp) -> Core (M TH.Type) -> MetaM (Core (M TH.Exp))
repAppType :: Core (M Exp) -> Core (M Type) -> MetaM (Core (M Exp))
repAppType (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
appTypeEName [CoreExpr
x,CoreExpr
y]
repLam :: Core [(M TH.Pat)] -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repLam :: Core [M Pat] -> Core (M Exp) -> MetaM (Core (M Exp))
repLam (MkC CoreExpr
ps) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
lamEName [CoreExpr
ps, CoreExpr
e]
repLamCase :: Core [(M TH.Match)] -> MetaM (Core (M TH.Exp))
repLamCase :: Core [M Match] -> MetaM (Core (M Exp))
repLamCase (MkC CoreExpr
ms) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
lamCaseEName [CoreExpr
ms]
repLamCases :: Core [(M TH.Clause)] -> MetaM (Core (M TH.Exp))
repLamCases :: Core [M Clause] -> MetaM (Core (M Exp))
repLamCases (MkC CoreExpr
ms) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
lamCasesEName [CoreExpr
ms]
repTup :: Core [Maybe (M TH.Exp)] -> MetaM (Core (M TH.Exp))
repTup :: Core [Maybe (M Exp)] -> MetaM (Core (M Exp))
repTup (MkC CoreExpr
es) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tupEName [CoreExpr
es]
repUnboxedTup :: Core [Maybe (M TH.Exp)] -> MetaM (Core (M TH.Exp))
repUnboxedTup :: Core [Maybe (M Exp)] -> MetaM (Core (M Exp))
repUnboxedTup (MkC CoreExpr
es) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedTupEName [CoreExpr
es]
repUnboxedSum :: Core (M TH.Exp) -> TH.SumAlt -> TH.SumArity -> MetaM (Core (M TH.Exp))
repUnboxedSum :: Core (M Exp) -> Int -> Int -> MetaM (Core (M Exp))
repUnboxedSum (MkC CoreExpr
e) Int
alt Int
arity
= do { Platform
platform <- MetaM Platform
getPlatform
; Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedSumEName [ CoreExpr
e
, Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
alt
, Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
arity ] }
repCond :: Core (M TH.Exp) -> Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repCond :: Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repCond (MkC CoreExpr
x) (MkC CoreExpr
y) (MkC CoreExpr
z) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
condEName [CoreExpr
x,CoreExpr
y,CoreExpr
z]
repMultiIf :: Core [M (TH.Guard, TH.Exp)] -> MetaM (Core (M TH.Exp))
repMultiIf :: Core [M (Guard, Exp)] -> MetaM (Core (M Exp))
repMultiIf (MkC CoreExpr
alts) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
multiIfEName [CoreExpr
alts]
repLetE :: Core [(M TH.Dec)] -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repLetE :: Core [M Dec] -> Core (M Exp) -> MetaM (Core (M Exp))
repLetE (MkC CoreExpr
ds) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
letEName [CoreExpr
ds, CoreExpr
e]
repCaseE :: Core (M TH.Exp) -> Core [(M TH.Match)] -> MetaM (Core (M TH.Exp))
repCaseE :: Core (M Exp) -> Core [M Match] -> MetaM (Core (M Exp))
repCaseE (MkC CoreExpr
e) (MkC CoreExpr
ms) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
caseEName [CoreExpr
e, CoreExpr
ms]
repDoE :: Maybe ModuleName -> Core [(M TH.Stmt)] -> MetaM (Core (M TH.Exp))
repDoE :: Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoE = Name -> Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoBlock Name
doEName
repMDoE :: Maybe ModuleName -> Core [(M TH.Stmt)] -> MetaM (Core (M TH.Exp))
repMDoE :: Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repMDoE = Name -> Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoBlock Name
mdoEName
repDoBlock :: Name -> Maybe ModuleName -> Core [(M TH.Stmt)] -> MetaM (Core (M TH.Exp))
repDoBlock :: Name -> Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoBlock Name
doName Maybe ModuleName
maybeModName (MkC CoreExpr
ss) = do
MkC CoreExpr
coreModName <- MetaM (Core (Maybe ModName))
coreModNameM
Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
doName [CoreExpr
coreModName, CoreExpr
ss]
where
coreModNameM :: MetaM (Core (Maybe TH.ModName))
coreModNameM :: MetaM (Core (Maybe ModName))
coreModNameM = case Maybe ModuleName
maybeModName of
Just ModuleName
m -> do
MkC CoreExpr
s <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit (ModuleName -> FastString
moduleNameFS ModuleName
m)
Core ModName
mName <- Name -> [CoreExpr] -> MetaM (Core ModName)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
mkModNameName [CoreExpr
s]
Name -> Core ModName -> MetaM (Core (Maybe ModName))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJust Name
modNameTyConName Core ModName
mName
Maybe ModuleName
_ -> Name -> MetaM (Core (Maybe ModName))
forall a. Name -> MetaM (Core (Maybe a))
coreNothing Name
modNameTyConName
repComp :: Core [(M TH.Stmt)] -> MetaM (Core (M TH.Exp))
repComp :: Core [M Stmt] -> MetaM (Core (M Exp))
repComp (MkC CoreExpr
ss) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
compEName [CoreExpr
ss]
repListExp :: Core [(M TH.Exp)] -> MetaM (Core (M TH.Exp))
repListExp :: Core [M Exp] -> MetaM (Core (M Exp))
repListExp (MkC CoreExpr
es) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
listEName [CoreExpr
es]
repSigExp :: Core (M TH.Exp) -> Core (M TH.Type) -> MetaM (Core (M TH.Exp))
repSigExp :: Core (M Exp) -> Core (M Type) -> MetaM (Core (M Exp))
repSigExp (MkC CoreExpr
e) (MkC CoreExpr
t) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sigEName [CoreExpr
e,CoreExpr
t]
repRecCon :: Core TH.Name -> Core [M TH.FieldExp]-> MetaM (Core (M TH.Exp))
repRecCon :: Core Name -> Core [M FieldExp] -> MetaM (Core (M Exp))
repRecCon (MkC CoreExpr
c) (MkC CoreExpr
fs) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recConEName [CoreExpr
c,CoreExpr
fs]
repRecUpd :: Core (M TH.Exp) -> Core [M TH.FieldExp] -> MetaM (Core (M TH.Exp))
repRecUpd :: Core (M Exp) -> Core [M FieldExp] -> MetaM (Core (M Exp))
repRecUpd (MkC CoreExpr
e) (MkC CoreExpr
fs) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recUpdEName [CoreExpr
e,CoreExpr
fs]
repFieldExp :: Core TH.Name -> Core (M TH.Exp) -> MetaM (Core (M TH.FieldExp))
repFieldExp :: Core Name -> Core (M Exp) -> MetaM (Core (M FieldExp))
repFieldExp (MkC CoreExpr
n) (MkC CoreExpr
x) = Name -> [CoreExpr] -> MetaM (Core (M FieldExp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fieldExpName [CoreExpr
n,CoreExpr
x]
repInfixApp :: Core (M TH.Exp) -> Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repInfixApp :: Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repInfixApp (MkC CoreExpr
x) (MkC CoreExpr
y) (MkC CoreExpr
z) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixAppName [CoreExpr
x,CoreExpr
y,CoreExpr
z]
repSectionL :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repSectionL :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repSectionL (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sectionLName [CoreExpr
x,CoreExpr
y]
repSectionR :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repSectionR :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repSectionR (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sectionRName [CoreExpr
x,CoreExpr
y]
repImplicitParamVar :: Core String -> MetaM (Core (M TH.Exp))
repImplicitParamVar :: Core String -> MetaM (Core (M Exp))
repImplicitParamVar (MkC CoreExpr
x) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
implicitParamVarEName [CoreExpr
x]
repGuarded :: Core [M (TH.Guard, TH.Exp)] -> MetaM (Core (M TH.Body))
repGuarded :: Core [M (Guard, Exp)] -> MetaM (Core (M Body))
repGuarded (MkC CoreExpr
pairs) = Name -> [CoreExpr] -> MetaM (Core (M Body))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
guardedBName [CoreExpr
pairs]
repNormal :: Core (M TH.Exp) -> MetaM (Core (M TH.Body))
repNormal :: Core (M Exp) -> MetaM (Core (M Body))
repNormal (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Body))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
normalBName [CoreExpr
e]
repLNormalGE :: LHsExpr GhcRn -> LHsExpr GhcRn
-> MetaM (Core (M (TH.Guard, TH.Exp)))
repLNormalGE :: LHsExpr GhcRn -> LHsExpr GhcRn -> MetaM (Core (M (Guard, Exp)))
repLNormalGE LHsExpr GhcRn
g LHsExpr GhcRn
e = do Core (M Exp)
g' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
g
Core (M Exp)
e' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
Core (M Exp) -> Core (M Exp) -> MetaM (Core (M (Guard, Exp)))
repNormalGE Core (M Exp)
g' Core (M Exp)
e'
repNormalGE :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M (TH.Guard, TH.Exp)))
repNormalGE :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M (Guard, Exp)))
repNormalGE (MkC CoreExpr
g) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M (Guard, Exp)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
normalGEName [CoreExpr
g, CoreExpr
e]
repPatGE :: Core [(M TH.Stmt)] -> Core (M TH.Exp) -> MetaM (Core (M (TH.Guard, TH.Exp)))
repPatGE :: Core [M Stmt] -> Core (M Exp) -> MetaM (Core (M (Guard, Exp)))
repPatGE (MkC CoreExpr
ss) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M (Guard, Exp)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
patGEName [CoreExpr
ss, CoreExpr
e]
repBindSt :: Core (M TH.Pat) -> Core (M TH.Exp) -> MetaM (Core (M TH.Stmt))
repBindSt :: Core (M Pat) -> Core (M Exp) -> MetaM (Core (M Stmt))
repBindSt (MkC CoreExpr
p) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Stmt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
bindSName [CoreExpr
p,CoreExpr
e]
repLetSt :: Core [(M TH.Dec)] -> MetaM (Core (M TH.Stmt))
repLetSt :: Core [M Dec] -> MetaM (Core (M Stmt))
repLetSt (MkC CoreExpr
ds) = Name -> [CoreExpr] -> MetaM (Core (M Stmt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
letSName [CoreExpr
ds]
repNoBindSt :: Core (M TH.Exp) -> MetaM (Core (M TH.Stmt))
repNoBindSt :: Core (M Exp) -> MetaM (Core (M Stmt))
repNoBindSt (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Stmt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
noBindSName [CoreExpr
e]
repParSt :: Core [[(M TH.Stmt)]] -> MetaM (Core (M TH.Stmt))
repParSt :: Core [[M Stmt]] -> MetaM (Core (M Stmt))
repParSt (MkC CoreExpr
sss) = Name -> [CoreExpr] -> MetaM (Core (M Stmt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
parSName [CoreExpr
sss]
repRecSt :: Core [(M TH.Stmt)] -> MetaM (Core (M TH.Stmt))
repRecSt :: Core [M Stmt] -> MetaM (Core (M Stmt))
repRecSt (MkC CoreExpr
ss) = Name -> [CoreExpr] -> MetaM (Core (M Stmt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recSName [CoreExpr
ss]
repFrom :: Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repFrom :: Core (M Exp) -> MetaM (Core (M Exp))
repFrom (MkC CoreExpr
x) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fromEName [CoreExpr
x]
repFromThen :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repFromThen :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repFromThen (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fromThenEName [CoreExpr
x,CoreExpr
y]
repFromTo :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repFromTo :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repFromTo (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fromToEName [CoreExpr
x,CoreExpr
y]
repFromThenTo :: Core (M TH.Exp) -> Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repFromThenTo :: Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repFromThenTo (MkC CoreExpr
x) (MkC CoreExpr
y) (MkC CoreExpr
z) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fromThenToEName [CoreExpr
x,CoreExpr
y,CoreExpr
z]
repMatch :: Core (M TH.Pat) -> Core (M TH.Body) -> Core [(M TH.Dec)] -> MetaM (Core (M TH.Match))
repMatch :: Core (M Pat)
-> Core (M Body)
-> Core [M Dec]
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatch (MkC CoreExpr
p) (MkC CoreExpr
bod) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M Match))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
matchName [CoreExpr
p, CoreExpr
bod, CoreExpr
ds]
repClause :: Core [(M TH.Pat)] -> Core (M TH.Body) -> Core [(M TH.Dec)] -> MetaM (Core (M TH.Clause))
repClause :: Core [M Pat]
-> Core (M Body)
-> Core [M Dec]
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClause (MkC CoreExpr
ps) (MkC CoreExpr
bod) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M Clause))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
clauseName [CoreExpr
ps, CoreExpr
bod, CoreExpr
ds]
repVal :: Core (M TH.Pat) -> Core (M TH.Body) -> Core [(M TH.Dec)] -> MetaM (Core (M TH.Dec))
repVal :: Core (M Pat)
-> Core (M Body) -> Core [M Dec] -> MetaM (Core (M Dec))
repVal (MkC CoreExpr
p) (MkC CoreExpr
b) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
valDName [CoreExpr
p, CoreExpr
b, CoreExpr
ds]
repFun :: Core TH.Name -> Core [(M TH.Clause)] -> MetaM (Core (M TH.Dec))
repFun :: Core Name -> Core [M Clause] -> MetaM (Core (M Dec))
repFun (MkC CoreExpr
nm) (MkC CoreExpr
b) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
funDName [CoreExpr
nm, CoreExpr
b]
repData :: Bool
-> Core (M TH.Cxt) -> Core TH.Name
-> Either (Core [(M (TH.TyVarBndr ()))])
(Core (Maybe [(M (TH.TyVarBndr ()))]), Core (M TH.Type))
-> Core (Maybe (M TH.Kind)) -> Core [(M TH.Con)] -> Core [M TH.DerivClause]
-> MetaM (Core (M TH.Dec))
repData :: Bool
-> Core (M Cxt)
-> Core Name
-> Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Core (Maybe (M Type))
-> Core [M Con]
-> Core [M DerivClause]
-> MetaM (Core (M Dec))
repData Bool
type_data (MkC CoreExpr
cxt) (MkC CoreExpr
nm) (Left (MkC CoreExpr
tvs)) (MkC CoreExpr
ksig) (MkC CoreExpr
cons) (MkC CoreExpr
derivs)
| Bool
type_data = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
typeDataDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
ksig, CoreExpr
cons]
| Bool
otherwise = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
dataDName [CoreExpr
cxt, CoreExpr
nm, CoreExpr
tvs, CoreExpr
ksig, CoreExpr
cons, CoreExpr
derivs]
repData Bool
_ (MkC CoreExpr
cxt) (MkC CoreExpr
_) (Right (MkC CoreExpr
mb_bndrs, MkC CoreExpr
ty)) (MkC CoreExpr
ksig) (MkC CoreExpr
cons)
(MkC CoreExpr
derivs)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
dataInstDName [CoreExpr
cxt, CoreExpr
mb_bndrs, CoreExpr
ty, CoreExpr
ksig, CoreExpr
cons, CoreExpr
derivs]
repNewtype :: Core (M TH.Cxt) -> Core TH.Name
-> Either (Core [(M (TH.TyVarBndr ()))])
(Core (Maybe [(M (TH.TyVarBndr ()))]), Core (M TH.Type))
-> Core (Maybe (M TH.Kind)) -> Core (M TH.Con) -> Core [M TH.DerivClause]
-> MetaM (Core (M TH.Dec))
repNewtype :: Core (M Cxt)
-> Core Name
-> Either
(Core [M (TyVarBndr ())])
(Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Core (Maybe (M Type))
-> Core (M Con)
-> Core [M DerivClause]
-> MetaM (Core (M Dec))
repNewtype (MkC CoreExpr
cxt) (MkC CoreExpr
nm) (Left (MkC CoreExpr
tvs)) (MkC CoreExpr
ksig) (MkC CoreExpr
con)
(MkC CoreExpr
derivs)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
newtypeDName [CoreExpr
cxt, CoreExpr
nm, CoreExpr
tvs, CoreExpr
ksig, CoreExpr
con, CoreExpr
derivs]
repNewtype (MkC CoreExpr
cxt) (MkC CoreExpr
_) (Right (MkC CoreExpr
mb_bndrs, MkC CoreExpr
ty)) (MkC CoreExpr
ksig) (MkC CoreExpr
con)
(MkC CoreExpr
derivs)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
newtypeInstDName [CoreExpr
cxt, CoreExpr
mb_bndrs, CoreExpr
ty, CoreExpr
ksig, CoreExpr
con, CoreExpr
derivs]
repTySyn :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
-> Core (M TH.Type) -> MetaM (Core (M TH.Dec))
repTySyn :: Core Name
-> Core [M (TyVarBndr ())] -> Core (M Type) -> MetaM (Core (M Dec))
repTySyn (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
rhs)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tySynDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
rhs]
repInst :: Core (Maybe TH.Overlap) ->
Core (M TH.Cxt) -> Core (M TH.Type) -> Core [(M TH.Dec)] -> MetaM (Core (M TH.Dec))
repInst :: Core (Maybe Overlap)
-> Core (M Cxt)
-> Core (M Type)
-> Core [M Dec]
-> MetaM (Core (M Dec))
repInst (MkC CoreExpr
o) (MkC CoreExpr
cxt) (MkC CoreExpr
ty) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
instanceWithOverlapDName
[CoreExpr
o, CoreExpr
cxt, CoreExpr
ty, CoreExpr
ds]
repDerivStrategy :: Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M TH.DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy :: forall a.
Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy Maybe (LDerivStrategy GhcRn)
mds Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside =
case Maybe (LDerivStrategy GhcRn)
mds of
Maybe (LDerivStrategy GhcRn)
Nothing -> Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
-> MetaM (Core (M a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall {a}. MetaM (Core (Maybe a))
nothing
Just LDerivStrategy GhcRn
ds ->
case GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcRn)
-> DerivStrategy GhcRn
forall l e. GenLocated l e -> e
unLoc LDerivStrategy GhcRn
GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcRn)
ds of
StockStrategy XStockStrategy GhcRn
_ -> Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
-> MetaM (Core (M a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Core (M DerivStrategy)
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core (M DerivStrategy)
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy))))
-> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repStockStrategy
AnyclassStrategy XAnyClassStrategy GhcRn
_ -> Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
-> MetaM (Core (M a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Core (M DerivStrategy)
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core (M DerivStrategy)
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy))))
-> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repAnyclassStrategy
NewtypeStrategy XNewtypeStrategy GhcRn
_ -> Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
-> MetaM (Core (M a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Core (M DerivStrategy)
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core (M DerivStrategy)
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy))))
-> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repNewtypeStrategy
ViaStrategy XViaStrategy GhcRn
ty -> FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a.
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
FreshNamesOnly (LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig XViaStrategy GhcRn
LHsSigType GhcRn
ty) (MetaM (Core (M a)) -> MetaM (Core (M a)))
-> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$
do Core (M Type)
ty' <- LHsSigType GhcRn -> MetaM (Core (M Type))
rep_ty_sig' XViaStrategy GhcRn
LHsSigType GhcRn
ty
Core (M DerivStrategy)
via_strat <- Core (M Type) -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repViaStrategy Core (M Type)
ty'
Core (Maybe (M DerivStrategy))
m_via_strat <- Core (M DerivStrategy)
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall {a}. Core a -> MetaM (Core (Maybe a))
just Core (M DerivStrategy)
via_strat
Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside Core (Maybe (M DerivStrategy))
m_via_strat
where
nothing :: MetaM (Core (Maybe a))
nothing = Name -> MetaM (Core (Maybe a))
forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
derivStrategyTyConName
just :: Core a -> MetaM (Core (Maybe a))
just = Name -> Core a -> MetaM (Core (Maybe a))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJustM Name
derivStrategyTyConName
repStockStrategy :: MetaM (Core (M TH.DerivStrategy))
repStockStrategy :: ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repStockStrategy = Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
stockStrategyName []
repAnyclassStrategy :: MetaM (Core (M TH.DerivStrategy))
repAnyclassStrategy :: ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repAnyclassStrategy = Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
anyclassStrategyName []
repNewtypeStrategy :: MetaM (Core (M TH.DerivStrategy))
repNewtypeStrategy :: ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repNewtypeStrategy = Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
newtypeStrategyName []
repViaStrategy :: Core (M TH.Type) -> MetaM (Core (M TH.DerivStrategy))
repViaStrategy :: Core (M Type) -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repViaStrategy (MkC CoreExpr
t) = Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
viaStrategyName [CoreExpr
t]
repOverlap :: Maybe OverlapMode -> MetaM (Core (Maybe TH.Overlap))
repOverlap :: Maybe OverlapMode -> MetaM (Core (Maybe Overlap))
repOverlap Maybe OverlapMode
mb =
case Maybe OverlapMode
mb of
Maybe OverlapMode
Nothing -> MetaM (Core (Maybe Overlap))
forall {a}. MetaM (Core (Maybe a))
nothing
Just OverlapMode
o ->
case OverlapMode
o of
NoOverlap SourceText
_ -> MetaM (Core (Maybe Overlap))
forall {a}. MetaM (Core (Maybe a))
nothing
Overlappable SourceText
_ -> Core Overlap -> MetaM (Core (Maybe Overlap))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core Overlap -> MetaM (Core (Maybe Overlap)))
-> ReaderT MetaWrappers DsM (Core Overlap)
-> MetaM (Core (Maybe Overlap))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> ReaderT MetaWrappers DsM (Core Overlap)
forall a. Name -> MetaM (Core a)
dataCon Name
overlappableDataConName
Overlapping SourceText
_ -> Core Overlap -> MetaM (Core (Maybe Overlap))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core Overlap -> MetaM (Core (Maybe Overlap)))
-> ReaderT MetaWrappers DsM (Core Overlap)
-> MetaM (Core (Maybe Overlap))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> ReaderT MetaWrappers DsM (Core Overlap)
forall a. Name -> MetaM (Core a)
dataCon Name
overlappingDataConName
Overlaps SourceText
_ -> Core Overlap -> MetaM (Core (Maybe Overlap))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core Overlap -> MetaM (Core (Maybe Overlap)))
-> ReaderT MetaWrappers DsM (Core Overlap)
-> MetaM (Core (Maybe Overlap))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> ReaderT MetaWrappers DsM (Core Overlap)
forall a. Name -> MetaM (Core a)
dataCon Name
overlapsDataConName
Incoherent SourceText
_ -> Core Overlap -> MetaM (Core (Maybe Overlap))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core Overlap -> MetaM (Core (Maybe Overlap)))
-> ReaderT MetaWrappers DsM (Core Overlap)
-> MetaM (Core (Maybe Overlap))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> ReaderT MetaWrappers DsM (Core Overlap)
forall a. Name -> MetaM (Core a)
dataCon Name
incoherentDataConName
where
nothing :: MetaM (Core (Maybe a))
nothing = Name -> MetaM (Core (Maybe a))
forall a. Name -> MetaM (Core (Maybe a))
coreNothing Name
overlapTyConName
just :: Core a -> MetaM (Core (Maybe a))
just = Name -> Core a -> MetaM (Core (Maybe a))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJust Name
overlapTyConName
repClass :: Core (M TH.Cxt) -> Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
-> Core [TH.FunDep] -> Core [(M TH.Dec)]
-> MetaM (Core (M TH.Dec))
repClass :: Core (M Cxt)
-> Core Name
-> Core [M (TyVarBndr ())]
-> Core [FunDep]
-> Core [M Dec]
-> MetaM (Core (M Dec))
repClass (MkC CoreExpr
cxt) (MkC CoreExpr
cls) (MkC CoreExpr
tvs) (MkC CoreExpr
fds) (MkC CoreExpr
ds)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
classDName [CoreExpr
cxt, CoreExpr
cls, CoreExpr
tvs, CoreExpr
fds, CoreExpr
ds]
repDeriv :: Core (Maybe (M TH.DerivStrategy))
-> Core (M TH.Cxt) -> Core (M TH.Type)
-> MetaM (Core (M TH.Dec))
repDeriv :: Core (Maybe (M DerivStrategy))
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Dec))
repDeriv (MkC CoreExpr
ds) (MkC CoreExpr
cxt) (MkC CoreExpr
ty)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
standaloneDerivWithStrategyDName [CoreExpr
ds, CoreExpr
cxt, CoreExpr
ty]
repPragInl :: Core TH.Name -> Core TH.Inline -> Core TH.RuleMatch
-> Core TH.Phases -> MetaM (Core (M TH.Dec))
repPragInl :: Core Name
-> Core Inline
-> Core RuleMatch
-> Core Phases
-> MetaM (Core (M Dec))
repPragInl (MkC CoreExpr
nm) (MkC CoreExpr
inline) (MkC CoreExpr
rm) (MkC CoreExpr
phases)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragInlDName [CoreExpr
nm, CoreExpr
inline, CoreExpr
rm, CoreExpr
phases]
repPragOpaque :: Core TH.Name -> MetaM (Core (M TH.Dec))
repPragOpaque :: Core Name -> MetaM (Core (M Dec))
repPragOpaque (MkC CoreExpr
nm) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragOpaqueDName [CoreExpr
nm]
repPragSpec :: Core TH.Name -> Core (M TH.Type) -> Core TH.Phases
-> MetaM (Core (M TH.Dec))
repPragSpec :: Core Name -> Core (M Type) -> Core Phases -> MetaM (Core (M Dec))
repPragSpec (MkC CoreExpr
nm) (MkC CoreExpr
ty) (MkC CoreExpr
phases)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecDName [CoreExpr
nm, CoreExpr
ty, CoreExpr
phases]
repPragSpecInl :: Core TH.Name -> Core (M TH.Type) -> Core TH.Inline
-> Core TH.Phases -> MetaM (Core (M TH.Dec))
repPragSpecInl :: Core Name
-> Core (M Type)
-> Core Inline
-> Core Phases
-> MetaM (Core (M Dec))
repPragSpecInl (MkC CoreExpr
nm) (MkC CoreExpr
ty) (MkC CoreExpr
inline) (MkC CoreExpr
phases)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecInlDName [CoreExpr
nm, CoreExpr
ty, CoreExpr
inline, CoreExpr
phases]
repPragSpecInst :: Core (M TH.Type) -> MetaM (Core (M TH.Dec))
repPragSpecInst :: Core (M Type) -> MetaM (Core (M Dec))
repPragSpecInst (MkC CoreExpr
ty) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecInstDName [CoreExpr
ty]
repPragComplete :: Core [TH.Name] -> Core (Maybe TH.Name) -> MetaM (Core (M TH.Dec))
repPragComplete :: Core [Name] -> Core (Maybe Name) -> MetaM (Core (M Dec))
repPragComplete (MkC CoreExpr
cls) (MkC CoreExpr
mty) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragCompleteDName [CoreExpr
cls, CoreExpr
mty]
repPragRule :: Core String -> Core (Maybe [(M (TH.TyVarBndr ()))])
-> Core [(M TH.RuleBndr)] -> Core (M TH.Exp) -> Core (M TH.Exp)
-> Core TH.Phases -> MetaM (Core (M TH.Dec))
repPragRule :: Core String
-> Core (Maybe [M (TyVarBndr ())])
-> Core [M RuleBndr]
-> Core (M Exp)
-> Core (M Exp)
-> Core Phases
-> MetaM (Core (M Dec))
repPragRule (MkC CoreExpr
nm) (MkC CoreExpr
ty_bndrs) (MkC CoreExpr
tm_bndrs) (MkC CoreExpr
lhs) (MkC CoreExpr
rhs) (MkC CoreExpr
phases)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragRuleDName [CoreExpr
nm, CoreExpr
ty_bndrs, CoreExpr
tm_bndrs, CoreExpr
lhs, CoreExpr
rhs, CoreExpr
phases]
repPragAnn :: Core TH.AnnTarget -> Core (M TH.Exp) -> MetaM (Core (M TH.Dec))
repPragAnn :: Core AnnTarget -> Core (M Exp) -> MetaM (Core (M Dec))
repPragAnn (MkC CoreExpr
targ) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragAnnDName [CoreExpr
targ, CoreExpr
e]
repTySynInst :: Core (M TH.TySynEqn) -> MetaM (Core (M TH.Dec))
repTySynInst :: Core (M TySynEqn) -> MetaM (Core (M Dec))
repTySynInst (MkC CoreExpr
eqn)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tySynInstDName [CoreExpr
eqn]
repDataFamilyD :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
-> Core (Maybe (M TH.Kind)) -> MetaM (Core (M TH.Dec))
repDataFamilyD :: Core Name
-> Core [M (TyVarBndr ())]
-> Core (Maybe (M Type))
-> MetaM (Core (M Dec))
repDataFamilyD (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
kind)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
dataFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
kind]
repOpenFamilyD :: Core TH.Name
-> Core [(M (TH.TyVarBndr ()))]
-> Core (M TH.FamilyResultSig)
-> Core (Maybe TH.InjectivityAnn)
-> MetaM (Core (M TH.Dec))
repOpenFamilyD :: Core Name
-> Core [M (TyVarBndr ())]
-> Core (M FamilyResultSig)
-> Core (Maybe InjectivityAnn)
-> MetaM (Core (M Dec))
repOpenFamilyD (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
result) (MkC CoreExpr
inj)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
openTypeFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
result, CoreExpr
inj]
repClosedFamilyD :: Core TH.Name
-> Core [(M (TH.TyVarBndr ()))]
-> Core (M TH.FamilyResultSig)
-> Core (Maybe TH.InjectivityAnn)
-> Core [(M TH.TySynEqn)]
-> MetaM (Core (M TH.Dec))
repClosedFamilyD :: Core Name
-> Core [M (TyVarBndr ())]
-> Core (M FamilyResultSig)
-> Core (Maybe InjectivityAnn)
-> Core [M TySynEqn]
-> MetaM (Core (M Dec))
repClosedFamilyD (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
res) (MkC CoreExpr
inj) (MkC CoreExpr
eqns)
= Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
closedTypeFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
res, CoreExpr
inj, CoreExpr
eqns]
repTySynEqn :: Core (Maybe [(M (TH.TyVarBndr ()))]) ->
Core (M TH.Type) -> Core (M TH.Type) -> MetaM (Core (M TH.TySynEqn))
repTySynEqn :: Core (Maybe [M (TyVarBndr ())])
-> Core (M Type)
-> Core (M Type)
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTySynEqn (MkC CoreExpr
mb_bndrs) (MkC CoreExpr
lhs) (MkC CoreExpr
rhs)
= Name -> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M TySynEqn))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tySynEqnName [CoreExpr
mb_bndrs, CoreExpr
lhs, CoreExpr
rhs]
repRoleAnnotD :: Core TH.Name -> Core [TH.Role] -> MetaM (Core (M TH.Dec))
repRoleAnnotD :: Core Name -> Core [Role] -> MetaM (Core (M Dec))
repRoleAnnotD (MkC CoreExpr
n) (MkC CoreExpr
roles) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
roleAnnotDName [CoreExpr
n, CoreExpr
roles]
repFunDep :: Core [TH.Name] -> Core [TH.Name] -> MetaM (Core TH.FunDep)
repFunDep :: Core [Name] -> Core [Name] -> MetaM (Core FunDep)
repFunDep (MkC CoreExpr
xs) (MkC CoreExpr
ys) = Name -> [CoreExpr] -> MetaM (Core FunDep)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
funDepName [CoreExpr
xs, CoreExpr
ys]
repProto :: Name -> Core TH.Name -> Core (M TH.Type) -> MetaM (Core (M TH.Dec))
repProto :: Name -> Core Name -> Core (M Type) -> MetaM (Core (M Dec))
repProto Name
mk_sig (MkC CoreExpr
s) (MkC CoreExpr
ty) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
mk_sig [CoreExpr
s, CoreExpr
ty]
repImplicitParamBind :: Core String -> Core (M TH.Exp) -> MetaM (Core (M TH.Dec))
repImplicitParamBind :: Core String -> Core (M Exp) -> MetaM (Core (M Dec))
repImplicitParamBind (MkC CoreExpr
n) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
implicitParamBindDName [CoreExpr
n, CoreExpr
e]
repCtxt :: Core [(M TH.Pred)] -> MetaM (Core (M TH.Cxt))
repCtxt :: Core [M Type] -> MetaM (Core (M Cxt))
repCtxt (MkC CoreExpr
tys) = Name -> [CoreExpr] -> MetaM (Core (M Cxt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
cxtName [CoreExpr
tys]
repH98DataCon :: LocatedN Name
-> HsConDeclH98Details GhcRn
-> MetaM (Core (M TH.Con))
repH98DataCon :: GenLocated SrcSpanAnnN Name
-> HsConDeclH98Details GhcRn -> MetaM (Core (M Con))
repH98DataCon GenLocated SrcSpanAnnN Name
con HsConDeclH98Details GhcRn
details
= do Core Name
con' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
con
case HsConDeclH98Details GhcRn
details of
PrefixCon [Void]
_ [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
ps -> do
Core [M BangType]
arg_tys <- [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
-> MetaM (Core [M BangType])
repPrefixConArgs [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
ps
Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
normalCName [Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC Core Name
con', Core [M BangType] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M BangType]
arg_tys]
InfixCon HsScaled GhcRn (XRec GhcRn (HsType GhcRn))
st1 HsScaled GhcRn (XRec GhcRn (HsType GhcRn))
st2 -> do
[HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
-> ReaderT MetaWrappers DsM ()
verifyLinearFields [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))
st1, HsScaled GhcRn (XRec GhcRn (HsType GhcRn))
st2]
Core (M BangType)
arg1 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M BangType))
repBangTy (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled GhcRn (XRec GhcRn (HsType GhcRn))
HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
st1)
Core (M BangType)
arg2 <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M BangType))
repBangTy (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled GhcRn (XRec GhcRn (HsType GhcRn))
HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
st2)
Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixCName [Core (M BangType) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M BangType)
arg1, Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC Core Name
con', Core (M BangType) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M BangType)
arg2]
RecCon XRec GhcRn [LConDeclField GhcRn]
ips -> do
Core [M VarBangType]
arg_vtys <- LocatedL [LConDeclField GhcRn] -> MetaM (Core [M VarBangType])
repRecConArgs XRec GhcRn [LConDeclField GhcRn]
LocatedL [LConDeclField GhcRn]
ips
Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recCName [Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC Core Name
con', Core [M VarBangType] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M VarBangType]
arg_vtys]
repGadtDataCons :: NonEmpty (LocatedN Name)
-> HsConDeclGADTDetails GhcRn
-> LHsType GhcRn
-> MetaM (Core (M TH.Con))
repGadtDataCons :: NonEmpty (GenLocated SrcSpanAnnN Name)
-> HsConDeclGADTDetails GhcRn
-> XRec GhcRn (HsType GhcRn)
-> MetaM (Core (M Con))
repGadtDataCons NonEmpty (GenLocated SrcSpanAnnN Name)
cons HsConDeclGADTDetails GhcRn
details XRec GhcRn (HsType GhcRn)
res_ty
= do NonEmpty (Core Name)
cons' <- (GenLocated SrcSpanAnnN Name -> MetaM (Core Name))
-> NonEmpty (GenLocated SrcSpanAnnN Name)
-> ReaderT MetaWrappers DsM (NonEmpty (Core Name))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc NonEmpty (GenLocated SrcSpanAnnN Name)
cons
case HsConDeclGADTDetails GhcRn
details of
PrefixConGADT [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
ps -> do
Core [M BangType]
arg_tys <- [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
-> MetaM (Core [M BangType])
repPrefixConArgs [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
ps
Core (M Type)
res_ty' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
res_ty
Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
gadtCName [ Core [Name] -> CoreExpr
forall a. Core a -> CoreExpr
unC (NonEmpty (Core Name) -> Core [Name]
forall a. NonEmpty (Core a) -> Core [a]
nonEmptyCoreList' NonEmpty (Core Name)
cons'), Core [M BangType] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M BangType]
arg_tys, Core (M Type) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Type)
res_ty']
RecConGADT XRec GhcRn [LConDeclField GhcRn]
ips LHsUniToken "->" "\8594" GhcRn
_ -> do
Core [M VarBangType]
arg_vtys <- LocatedL [LConDeclField GhcRn] -> MetaM (Core [M VarBangType])
repRecConArgs XRec GhcRn [LConDeclField GhcRn]
LocatedL [LConDeclField GhcRn]
ips
Core (M Type)
res_ty' <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M Type))
repLTy XRec GhcRn (HsType GhcRn)
res_ty
Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recGadtCName [Core [Name] -> CoreExpr
forall a. Core a -> CoreExpr
unC (NonEmpty (Core Name) -> Core [Name]
forall a. NonEmpty (Core a) -> Core [a]
nonEmptyCoreList' NonEmpty (Core Name)
cons'), Core [M VarBangType] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M VarBangType]
arg_vtys,
Core (M Type) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Type)
res_ty']
verifyLinearFields :: [HsScaled GhcRn (LHsType GhcRn)] -> MetaM ()
verifyLinearFields :: [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
-> ReaderT MetaWrappers DsM ()
verifyLinearFields [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
ps = do
Bool
linear <- DsM Bool -> ReaderT MetaWrappers DsM Bool
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM Bool -> ReaderT MetaWrappers DsM Bool)
-> DsM Bool -> ReaderT MetaWrappers DsM Bool
forall a b. (a -> b) -> a -> b
$ Extension -> DsM Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.LinearTypes
let allGood :: Bool
allGood = (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)) -> Bool)
-> [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
st -> case HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> HsArrow GhcRn
forall pass a. HsScaled pass a -> HsArrow pass
hsMult HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
st of
HsUnrestrictedArrow LHsUniToken "->" "\8594" GhcRn
_ -> Bool -> Bool
not Bool
linear
HsLinearArrow HsLinearArrowTokens GhcRn
_ -> Bool
True
HsArrow GhcRn
_ -> Bool
False) [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
[HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
ps
Bool -> ReaderT MetaWrappers DsM () -> ReaderT MetaWrappers DsM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allGood (ReaderT MetaWrappers DsM () -> ReaderT MetaWrappers DsM ())
-> ReaderT MetaWrappers DsM () -> ReaderT MetaWrappers DsM ()
forall a b. (a -> b) -> a -> b
$ ThRejectionReason -> ReaderT MetaWrappers DsM ()
forall a. ThRejectionReason -> MetaM a
notHandled ThRejectionReason
ThNonLinearDataCon
repPrefixConArgs :: [HsScaled GhcRn (LHsType GhcRn)]
-> MetaM (Core [M TH.BangType])
repPrefixConArgs :: [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
-> MetaM (Core [M BangType])
repPrefixConArgs [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
ps = do
[HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
-> ReaderT MetaWrappers DsM ()
verifyLinearFields [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
ps
Name
-> (GenLocated SrcSpanAnnA (HsType GhcRn)
-> MetaM (Core (M BangType)))
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> MetaM (Core [M BangType])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
bangTypeTyConName XRec GhcRn (HsType GhcRn) -> MetaM (Core (M BangType))
GenLocated SrcSpanAnnA (HsType GhcRn) -> MetaM (Core (M BangType))
repBangTy ((HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> GenLocated SrcSpanAnnA (HsType GhcRn))
-> [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall pass a. HsScaled pass a -> a
hsScaledThing [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
[HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
ps)
repRecConArgs :: LocatedL [LConDeclField GhcRn]
-> MetaM (Core [M TH.VarBangType])
repRecConArgs :: LocatedL [LConDeclField GhcRn] -> MetaM (Core [M VarBangType])
repRecConArgs LocatedL [LConDeclField GhcRn]
ips = do
[Core (M VarBangType)]
args <- (GenLocated SrcSpanAnnA (ConDeclField GhcRn)
-> ReaderT MetaWrappers DsM [Core (M VarBangType)])
-> [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM GenLocated SrcSpanAnnA (ConDeclField GhcRn)
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
forall {l}.
GenLocated l (ConDeclField GhcRn)
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
rep_ip (GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
-> [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
forall l e. GenLocated l e -> e
unLoc LocatedL [LConDeclField GhcRn]
GenLocated
SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
ips)
Name -> [Core (M VarBangType)] -> MetaM (Core [M VarBangType])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
varBangTypeTyConName [Core (M VarBangType)]
args
where
rep_ip :: GenLocated l (ConDeclField GhcRn)
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
rep_ip (L l
_ ConDeclField GhcRn
ip) = (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
-> ReaderT MetaWrappers DsM (Core (M VarBangType)))
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)]
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
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 (XRec GhcRn (HsType GhcRn)
-> LFieldOcc GhcRn
-> ReaderT MetaWrappers DsM (Core (M VarBangType))
rep_one_ip (ConDeclField GhcRn -> XRec GhcRn (HsType GhcRn)
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type ConDeclField GhcRn
ip)) (ConDeclField GhcRn -> [LFieldOcc GhcRn]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names ConDeclField GhcRn
ip)
rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> MetaM (Core (M TH.VarBangType))
rep_one_ip :: XRec GhcRn (HsType GhcRn)
-> LFieldOcc GhcRn
-> ReaderT MetaWrappers DsM (Core (M VarBangType))
rep_one_ip XRec GhcRn (HsType GhcRn)
t LFieldOcc GhcRn
n = do { MkC CoreExpr
v <- Name -> MetaM (Core Name)
lookupOcc (FieldOcc GhcRn -> XCFieldOcc GhcRn
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt (FieldOcc GhcRn -> XCFieldOcc GhcRn)
-> FieldOcc GhcRn -> XCFieldOcc GhcRn
forall a b. (a -> b) -> a -> b
$ GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn) -> FieldOcc GhcRn
forall l e. GenLocated l e -> e
unLoc LFieldOcc GhcRn
GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
n)
; MkC CoreExpr
ty <- XRec GhcRn (HsType GhcRn) -> MetaM (Core (M BangType))
repBangTy XRec GhcRn (HsType GhcRn)
t
; Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M VarBangType))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
varBangTypeName [CoreExpr
v,CoreExpr
ty] }
repTForall :: Core [(M (TH.TyVarBndr TH.Specificity))] -> Core (M TH.Cxt) -> Core (M TH.Type)
-> MetaM (Core (M TH.Type))
repTForall :: Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall (MkC CoreExpr
tvars) (MkC CoreExpr
ctxt) (MkC CoreExpr
ty)
= Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forallTName [CoreExpr
tvars, CoreExpr
ctxt, CoreExpr
ty]
repTForallVis :: Core [(M (TH.TyVarBndr ()))] -> Core (M TH.Type)
-> MetaM (Core (M TH.Type))
repTForallVis :: Core [M (TyVarBndr ())] -> Core (M Type) -> MetaM (Core (M Type))
repTForallVis (MkC CoreExpr
tvars) (MkC CoreExpr
ty) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forallVisTName [CoreExpr
tvars, CoreExpr
ty]
repTvar :: Core TH.Name -> MetaM (Core (M TH.Type))
repTvar :: Core Name -> MetaM (Core (M Type))
repTvar (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
varTName [CoreExpr
s]
repTapp :: Core (M TH.Type) -> Core (M TH.Type) -> MetaM (Core (M TH.Type))
repTapp :: Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp (MkC CoreExpr
t1) (MkC CoreExpr
t2) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
appTName [CoreExpr
t1, CoreExpr
t2]
repTappKind :: Core (M TH.Type) -> Core (M TH.Kind) -> MetaM (Core (M TH.Type))
repTappKind :: Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTappKind (MkC CoreExpr
ty) (MkC CoreExpr
ki) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
appKindTName [CoreExpr
ty,CoreExpr
ki]
repTapps :: Core (M TH.Type) -> [Core (M TH.Type)] -> MetaM (Core (M TH.Type))
repTapps :: Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
f [] = Core (M Type) -> MetaM (Core (M Type))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Type)
f
repTapps Core (M Type)
f (Core (M Type)
t:[Core (M Type)]
ts) = do { Core (M Type)
f1 <- Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
f Core (M Type)
t; Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
f1 [Core (M Type)]
ts }
repTSig :: Core (M TH.Type) -> Core (M TH.Kind) -> MetaM (Core (M TH.Type))
repTSig :: Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTSig (MkC CoreExpr
ty) (MkC CoreExpr
ki) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sigTName [CoreExpr
ty, CoreExpr
ki]
repTequality :: MetaM (Core (M TH.Type))
repTequality :: MetaM (Core (M Type))
repTequality = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
equalityTName []
repTPromotedList :: [Core (M TH.Type)] -> MetaM (Core (M TH.Type))
repTPromotedList :: [Core (M Type)] -> MetaM (Core (M Type))
repTPromotedList [] = MetaM (Core (M Type))
repPromotedNilTyCon
repTPromotedList (Core (M Type)
t:[Core (M Type)]
ts) = do { Core (M Type)
tcon <- MetaM (Core (M Type))
repPromotedConsTyCon
; Core (M Type)
f <- Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
tcon Core (M Type)
t
; Core (M Type)
t' <- [Core (M Type)] -> MetaM (Core (M Type))
repTPromotedList [Core (M Type)]
ts
; Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
f Core (M Type)
t'
}
repTLit :: Core (M TH.TyLit) -> MetaM (Core (M TH.Type))
repTLit :: Core (M TyLit) -> MetaM (Core (M Type))
repTLit (MkC CoreExpr
lit) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
litTName [CoreExpr
lit]
repTWildCard :: MetaM (Core (M TH.Type))
repTWildCard :: MetaM (Core (M Type))
repTWildCard = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
wildCardTName []
repTImplicitParam :: Core String -> Core (M TH.Type) -> MetaM (Core (M TH.Type))
repTImplicitParam :: Core String -> Core (M Type) -> MetaM (Core (M Type))
repTImplicitParam (MkC CoreExpr
n) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
implicitParamTName [CoreExpr
n, CoreExpr
e]
repTStar :: MetaM (Core (M TH.Type))
repTStar :: MetaM (Core (M Type))
repTStar = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
starKName []
repTConstraint :: MetaM (Core (M TH.Type))
repTConstraint :: MetaM (Core (M Type))
repTConstraint = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
constraintKName []
repNamedTyCon :: Core TH.Name -> MetaM (Core (M TH.Type))
repNamedTyCon :: Core Name -> MetaM (Core (M Type))
repNamedTyCon (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
conTName [CoreExpr
s]
repTInfix :: Core (M TH.Type) -> Core TH.Name -> Core (M TH.Type)
-> MetaM (Core (M TH.Type))
repTInfix :: Core (M Type)
-> Core Name -> Core (M Type) -> MetaM (Core (M Type))
repTInfix (MkC CoreExpr
t1) (MkC CoreExpr
name) (MkC CoreExpr
t2) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixTName [CoreExpr
t1,CoreExpr
name,CoreExpr
t2]
repTupleTyCon :: Int -> MetaM (Core (M TH.Type))
repTupleTyCon :: Int -> MetaM (Core (M Type))
repTupleTyCon Int
i = do Platform
platform <- MetaM Platform
getPlatform
Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tupleTName [Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
i]
repUnboxedTupleTyCon :: Int -> MetaM (Core (M TH.Type))
repUnboxedTupleTyCon :: Int -> MetaM (Core (M Type))
repUnboxedTupleTyCon Int
i = do Platform
platform <- MetaM Platform
getPlatform
Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedTupleTName [Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
i]
repUnboxedSumTyCon :: TH.SumArity -> MetaM (Core (M TH.Type))
repUnboxedSumTyCon :: Int -> MetaM (Core (M Type))
repUnboxedSumTyCon Int
arity = do Platform
platform <- MetaM Platform
getPlatform
Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedSumTName [Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
arity]
repArrowTyCon :: MetaM (Core (M TH.Type))
repArrowTyCon :: MetaM (Core (M Type))
repArrowTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
arrowTName []
repMulArrowTyCon :: MetaM (Core (M TH.Type))
repMulArrowTyCon :: MetaM (Core (M Type))
repMulArrowTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
mulArrowTName []
repListTyCon :: MetaM (Core (M TH.Type))
repListTyCon :: MetaM (Core (M Type))
repListTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
listTName []
repPromotedDataCon :: Core TH.Name -> MetaM (Core (M TH.Type))
repPromotedDataCon :: Core Name -> MetaM (Core (M Type))
repPromotedDataCon (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
promotedTName [CoreExpr
s]
repPromotedTupleTyCon :: Int -> MetaM (Core (M TH.Type))
repPromotedTupleTyCon :: Int -> MetaM (Core (M Type))
repPromotedTupleTyCon Int
i = do Platform
platform <- MetaM Platform
getPlatform
Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
promotedTupleTName [Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
i]
repPromotedNilTyCon :: MetaM (Core (M TH.Type))
repPromotedNilTyCon :: MetaM (Core (M Type))
repPromotedNilTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
promotedNilTName []
repPromotedConsTyCon :: MetaM (Core (M TH.Type))
repPromotedConsTyCon :: MetaM (Core (M Type))
repPromotedConsTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
promotedConsTName []
repNoSig :: MetaM (Core (M TH.FamilyResultSig))
repNoSig :: MetaM (Core (M FamilyResultSig))
repNoSig = Name -> [CoreExpr] -> MetaM (Core (M FamilyResultSig))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
noSigName []
repKindSig :: Core (M TH.Kind) -> MetaM (Core (M TH.FamilyResultSig))
repKindSig :: Core (M Type) -> MetaM (Core (M FamilyResultSig))
repKindSig (MkC CoreExpr
ki) = Name -> [CoreExpr] -> MetaM (Core (M FamilyResultSig))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
kindSigName [CoreExpr
ki]
repTyVarSig :: Core (M (TH.TyVarBndr ())) -> MetaM (Core (M TH.FamilyResultSig))
repTyVarSig :: Core (M (TyVarBndr ())) -> MetaM (Core (M FamilyResultSig))
repTyVarSig (MkC CoreExpr
bndr) = Name -> [CoreExpr] -> MetaM (Core (M FamilyResultSig))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tyVarSigName [CoreExpr
bndr]
repLiteral :: HsLit GhcRn -> MetaM (Core TH.Lit)
repLiteral :: HsLit GhcRn -> MetaM (Core Lit)
repLiteral (HsStringPrim XHsStringPrim GhcRn
_ ByteString
bs)
= do Type
word8_ty <- Name -> MetaM Type
lookupType Name
word8TyConName
let w8s :: [Word8]
w8s = ByteString -> [Word8]
unpack ByteString
bs
w8s_expr :: [CoreExpr]
w8s_expr = (Word8 -> CoreExpr) -> [Word8] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (\Word8
w8 -> DataCon -> [CoreExpr] -> CoreExpr
mkCoreConApps DataCon
word8DataCon
[Integer -> CoreExpr
forall b. Integer -> Expr b
mkWord8Lit (Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
w8)]) [Word8]
w8s
Name -> [CoreExpr] -> MetaM (Core Lit)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
stringPrimLName [Type -> [CoreExpr] -> CoreExpr
mkListExpr Type
word8_ty [CoreExpr]
w8s_expr]
repLiteral HsLit GhcRn
lit
= do HsLit GhcRn
lit' <- case HsLit GhcRn
lit of
HsIntPrim XHsIntPrim GhcRn
_ Integer
i -> Integer -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_integer Integer
i
HsWordPrim XHsWordPrim GhcRn
_ Integer
w -> Integer -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_integer Integer
w
HsInt XHsInt GhcRn
_ IntegralLit
i -> Integer -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_integer (IntegralLit -> Integer
il_value IntegralLit
i)
HsFloatPrim XHsFloatPrim GhcRn
_ FractionalLit
r -> FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_rational FractionalLit
r
HsDoublePrim XHsDoublePrim GhcRn
_ FractionalLit
r -> FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_rational FractionalLit
r
HsCharPrim XHsCharPrim GhcRn
_ Char
c -> Char -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_char Char
c
HsLit GhcRn
_ -> HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return HsLit GhcRn
lit
CoreExpr
lit_expr <- DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr)
-> DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ HsLit GhcRn -> DsM CoreExpr
dsLit HsLit GhcRn
lit'
case Maybe Name
mb_lit_name of
Just Name
lit_name -> Name -> [CoreExpr] -> MetaM (Core Lit)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
lit_name [CoreExpr
lit_expr]
Maybe Name
Nothing -> ThRejectionReason -> MetaM (Core Lit)
forall a. ThRejectionReason -> MetaM a
notHandled (HsLit GhcRn -> ThRejectionReason
ThExoticLiteral HsLit GhcRn
lit)
where
mb_lit_name :: Maybe Name
mb_lit_name = case HsLit GhcRn
lit of
HsInteger XHsInteger GhcRn
_ Integer
_ Type
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
integerLName
HsInt XHsInt GhcRn
_ IntegralLit
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
integerLName
HsIntPrim XHsIntPrim GhcRn
_ Integer
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
intPrimLName
HsWordPrim XHsWordPrim GhcRn
_ Integer
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
wordPrimLName
HsFloatPrim XHsFloatPrim GhcRn
_ FractionalLit
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
floatPrimLName
HsDoublePrim XHsDoublePrim GhcRn
_ FractionalLit
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
doublePrimLName
HsChar XHsChar GhcRn
_ Char
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
charLName
HsCharPrim XHsCharPrim GhcRn
_ Char
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
charPrimLName
HsString XHsString GhcRn
_ FastString
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
stringLName
HsRat XHsRat GhcRn
_ FractionalLit
_ Type
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
rationalLName
HsLit GhcRn
_ -> Maybe Name
forall a. Maybe a
Nothing
mk_integer :: Integer -> MetaM (HsLit GhcRn)
mk_integer :: Integer -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_integer Integer
i = HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn))
-> HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a b. (a -> b) -> a -> b
$ XHsInteger GhcRn -> Integer -> Type -> HsLit GhcRn
forall x. XHsInteger x -> Integer -> Type -> HsLit x
HsInteger XHsInteger GhcRn
SourceText
NoSourceText Integer
i Type
integerTy
mk_rational :: FractionalLit -> MetaM (HsLit GhcRn)
mk_rational :: FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_rational FractionalLit
r = do Type
rat_ty <- Name -> MetaM Type
lookupType Name
rationalTyConName
HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn))
-> HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a b. (a -> b) -> a -> b
$ XHsRat GhcRn -> FractionalLit -> Type -> HsLit GhcRn
forall x. XHsRat x -> FractionalLit -> Type -> HsLit x
HsRat XHsRat GhcRn
NoExtField
noExtField FractionalLit
r Type
rat_ty
mk_string :: FastString -> MetaM (HsLit GhcRn)
mk_string :: FastString -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_string FastString
s = HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn))
-> HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a b. (a -> b) -> a -> b
$ XHsString GhcRn -> FastString -> HsLit GhcRn
forall x. XHsString x -> FastString -> HsLit x
HsString XHsString GhcRn
SourceText
NoSourceText FastString
s
mk_char :: Char -> MetaM (HsLit GhcRn)
mk_char :: Char -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_char Char
c = HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn))
-> HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a b. (a -> b) -> a -> b
$ XHsChar GhcRn -> Char -> HsLit GhcRn
forall x. XHsChar x -> Char -> HsLit x
HsChar XHsChar GhcRn
SourceText
NoSourceText Char
c
repOverloadedLiteral :: HsOverLit GhcRn -> MetaM (Core TH.Lit)
repOverloadedLiteral :: HsOverLit GhcRn -> MetaM (Core Lit)
repOverloadedLiteral (OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = OverLitVal
val})
= do { HsLit GhcRn
lit <- OverLitVal -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_lit OverLitVal
val; HsLit GhcRn -> MetaM (Core Lit)
repLiteral HsLit GhcRn
lit }
mk_lit :: OverLitVal -> MetaM (HsLit GhcRn)
mk_lit :: OverLitVal -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_lit (HsIntegral IntegralLit
i) = Integer -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_integer (IntegralLit -> Integer
il_value IntegralLit
i)
mk_lit (HsFractional FractionalLit
f) = FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_rational FractionalLit
f
mk_lit (HsIsString SourceText
_ FastString
s) = FastString -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_string FastString
s
repRdrName :: RdrName -> MetaM (Core TH.Name)
repRdrName :: RdrName -> MetaM (Core Name)
repRdrName RdrName
rdr_name = do
case RdrName
rdr_name of
Unqual OccName
occ ->
Core String -> MetaM (Core Name)
repNameS (Core String -> MetaM (Core Name))
-> ReaderT MetaWrappers DsM (Core String) -> MetaM (Core Name)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< OccName -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *). MonadThings m => OccName -> m (Core String)
occNameLit OccName
occ
Qual ModuleName
mn OccName
occ -> do
let name_mod :: FastString
name_mod = ModuleName -> FastString
moduleNameFS ModuleName
mn
Core String
mod <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
name_mod
Core String
occ <- OccName -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *). MonadThings m => OccName -> m (Core String)
occNameLit OccName
occ
Core String -> Core String -> MetaM (Core Name)
repNameQ Core String
mod Core String
occ
Orig Module
m OccName
n -> DsM (Core Name) -> MetaM (Core Name)
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM (Core Name) -> MetaM (Core Name))
-> DsM (Core Name) -> MetaM (Core Name)
forall a b. (a -> b) -> a -> b
$ Module -> OccName -> DsM (Core Name)
globalVarExternal Module
m OccName
n
Exact Name
n -> DsM (Core Name) -> MetaM (Core Name)
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM (Core Name) -> MetaM (Core Name))
-> DsM (Core Name) -> MetaM (Core Name)
forall a b. (a -> b) -> a -> b
$ Name -> DsM (Core Name)
globalVar Name
n
repNameS :: Core String -> MetaM (Core TH.Name)
repNameS :: Core String -> MetaM (Core Name)
repNameS (MkC CoreExpr
name) = Name -> [CoreExpr] -> MetaM (Core Name)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
mkNameSName [CoreExpr
name]
repNameQ :: Core String -> Core String -> MetaM (Core TH.Name)
repNameQ :: Core String -> Core String -> MetaM (Core Name)
repNameQ (MkC CoreExpr
mn) (MkC CoreExpr
name) = Name -> [CoreExpr] -> MetaM (Core Name)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
mkNameQName [CoreExpr
mn, CoreExpr
name]
repGensym :: Core String -> MetaM (Core (M TH.Name))
repGensym :: Core String -> MetaM (Core (M Name))
repGensym (MkC CoreExpr
lit_str) = Name -> [CoreExpr] -> MetaM (Core (M Name))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
newNameName [CoreExpr
lit_str]
repBindM :: Type -> Type
-> Core (M a) -> Core (a -> M b) -> MetaM (Core (M b))
repBindM :: forall a b.
Type -> Type -> Core (M a) -> Core (a -> M b) -> MetaM (Core (M b))
repBindM Type
ty_a Type
ty_b (MkC CoreExpr
x) (MkC CoreExpr
y)
= Name -> [CoreExpr] -> MetaM (Core (M b))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2M Name
bindMName [Type -> CoreExpr
forall b. Type -> Expr b
Type Type
ty_a, Type -> CoreExpr
forall b. Type -> Expr b
Type Type
ty_b, CoreExpr
x, CoreExpr
y]
repSequenceM :: Type -> Core [M a] -> MetaM (Core (M [a]))
repSequenceM :: forall a. Type -> Core [M a] -> MetaM (Core (M [a]))
repSequenceM Type
ty_a (MkC CoreExpr
list)
= Name -> [CoreExpr] -> MetaM (Core (M [a]))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2M Name
sequenceQName [Type -> CoreExpr
forall b. Type -> Expr b
Type Type
ty_a, CoreExpr
list]
repUnboundVar :: Core TH.Name -> MetaM (Core (M TH.Exp))
repUnboundVar :: Core Name -> MetaM (Core (M Exp))
repUnboundVar (MkC CoreExpr
name) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboundVarEName [CoreExpr
name]
repOverLabel :: FastString -> MetaM (Core (M TH.Exp))
repOverLabel :: FastString -> MetaM (Core (M Exp))
repOverLabel FastString
fs = do
MkC CoreExpr
s <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
fs
Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
labelEName [CoreExpr
s]
repGetField :: Core (M TH.Exp) -> FastString -> MetaM (Core (M TH.Exp))
repGetField :: Core (M Exp) -> FastString -> MetaM (Core (M Exp))
repGetField (MkC CoreExpr
exp) FastString
fs = do
MkC CoreExpr
s <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
fs
Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
getFieldEName [CoreExpr
exp,CoreExpr
s]
repProjection :: NonEmpty FastString -> MetaM (Core (M TH.Exp))
repProjection :: NonEmpty FastString -> MetaM (Core (M Exp))
repProjection NonEmpty FastString
fs = do
TyCon
ne_tycon <- DsM TyCon -> ReaderT MetaWrappers DsM TyCon
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM TyCon -> ReaderT MetaWrappers DsM TyCon)
-> DsM TyCon -> ReaderT MetaWrappers DsM TyCon
forall a b. (a -> b) -> a -> b
$ Name -> DsM TyCon
dsLookupTyCon Name
nonEmptyTyConName
MkC CoreExpr
xs <- TyCon -> Type -> NonEmpty (Core String) -> Core (NonEmpty String)
forall a. TyCon -> Type -> NonEmpty (Core a) -> Core (NonEmpty a)
coreListNonEmpty TyCon
ne_tycon Type
stringTy (NonEmpty (Core String) -> Core (NonEmpty String))
-> ReaderT MetaWrappers DsM (NonEmpty (Core String))
-> ReaderT MetaWrappers DsM (Core (NonEmpty String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(FastString -> ReaderT MetaWrappers DsM (Core String))
-> NonEmpty FastString
-> ReaderT MetaWrappers DsM (NonEmpty (Core String))
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) -> NonEmpty a -> m (NonEmpty b)
mapM FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit NonEmpty FastString
fs
Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
projectionEName [CoreExpr
xs]
repList :: Name -> (a -> MetaM (Core b))
-> [a] -> MetaM (Core [b])
repList :: forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
tc_name a -> MetaM (Core b)
f [a]
args
= do { [Core b]
args1 <- (a -> MetaM (Core b)) -> [a] -> ReaderT MetaWrappers DsM [Core b]
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 a -> MetaM (Core b)
f [a]
args
; Name -> [Core b] -> MetaM (Core [b])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreList Name
tc_name [Core b]
args1 }
repListM :: Name -> (a -> MetaM (Core b))
-> [a] -> MetaM (Core [b])
repListM :: forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
tc_name a -> MetaM (Core b)
f [a]
args
= do { Type
ty <- Name -> MetaM Type
wrapName Name
tc_name
; [Core b]
args1 <- (a -> MetaM (Core b)) -> [a] -> ReaderT MetaWrappers DsM [Core b]
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 a -> MetaM (Core b)
f [a]
args
; Core [b] -> MetaM (Core [b])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Core [b] -> MetaM (Core [b])) -> Core [b] -> MetaM (Core [b])
forall a b. (a -> b) -> a -> b
$ Type -> [Core b] -> Core [b]
forall a. Type -> [Core a] -> Core [a]
coreList' Type
ty [Core b]
args1 }
coreListM :: Name -> [Core a] -> MetaM (Core [a])
coreListM :: forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
tc [Core a]
as = Name -> (Core a -> MetaM (Core a)) -> [Core a] -> MetaM (Core [a])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
tc Core a -> MetaM (Core a)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Core a]
as
coreList :: Name
-> [Core a] -> MetaM (Core [a])
coreList :: forall a. Name -> [Core a] -> MetaM (Core [a])
coreList Name
tc_name [Core a]
es
= do { Type
elt_ty <- Name -> MetaM Type
lookupType Name
tc_name; Core [a] -> MetaM (Core [a])
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> [Core a] -> Core [a]
forall a. Type -> [Core a] -> Core [a]
coreList' Type
elt_ty [Core a]
es) }
coreList' :: Type
-> [Core a] -> Core [a]
coreList' :: forall a. Type -> [Core a] -> Core [a]
coreList' Type
elt_ty [Core a]
es = CoreExpr -> Core [a]
forall a. CoreExpr -> Core a
MkC (Type -> [CoreExpr] -> CoreExpr
mkListExpr Type
elt_ty ((Core a -> CoreExpr) -> [Core a] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map Core a -> CoreExpr
forall a. Core a -> CoreExpr
unC [Core a]
es ))
coreListNonEmpty :: TyCon
-> Type
-> NonEmpty (Core a)
-> Core (NonEmpty a)
coreListNonEmpty :: forall a. TyCon -> Type -> NonEmpty (Core a) -> Core (NonEmpty a)
coreListNonEmpty TyCon
ne_tc Type
ty (MkC CoreExpr
x :| [Core a]
xs)
= CoreExpr -> Core (NonEmpty a)
forall a. CoreExpr -> Core a
MkC (CoreExpr -> Core (NonEmpty a)) -> CoreExpr -> Core (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ DataCon -> [CoreExpr] -> CoreExpr
mkCoreConApps (TyCon -> DataCon
tyConSingleDataCon TyCon
ne_tc)
[Type -> CoreExpr
forall b. Type -> Expr b
Type Type
ty, CoreExpr
x, Type -> [CoreExpr] -> CoreExpr
mkListExpr Type
ty ((Core a -> CoreExpr) -> [Core a] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map Core a -> CoreExpr
forall a. Core a -> CoreExpr
unC [Core a]
xs)]
nonEmptyCoreList :: [Core a] -> Core [a]
nonEmptyCoreList :: forall a. [Core a] -> Core [a]
nonEmptyCoreList [] = String -> Core [a]
forall a. HasCallStack => String -> a
panic String
"coreList: empty argument"
nonEmptyCoreList xs :: [Core a]
xs@(MkC CoreExpr
x:[Core a]
_) = CoreExpr -> Core [a]
forall a. CoreExpr -> Core a
MkC (Type -> [CoreExpr] -> CoreExpr
mkListExpr ((() :: Constraint) => CoreExpr -> Type
CoreExpr -> Type
exprType CoreExpr
x) ((Core a -> CoreExpr) -> [Core a] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map Core a -> CoreExpr
forall a. Core a -> CoreExpr
unC [Core a]
xs))
nonEmptyCoreList' :: NonEmpty (Core a) -> Core [a]
nonEmptyCoreList' :: forall a. NonEmpty (Core a) -> Core [a]
nonEmptyCoreList' xs :: NonEmpty (Core a)
xs@(MkC CoreExpr
x:|[Core a]
_) = CoreExpr -> Core [a]
forall a. CoreExpr -> Core a
MkC (Type -> [CoreExpr] -> CoreExpr
mkListExpr ((() :: Constraint) => CoreExpr -> Type
CoreExpr -> Type
exprType CoreExpr
x) (NonEmpty CoreExpr -> [CoreExpr]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty CoreExpr -> [CoreExpr])
-> NonEmpty CoreExpr -> [CoreExpr]
forall a b. (a -> b) -> a -> b
$ (Core a -> CoreExpr) -> NonEmpty (Core a) -> NonEmpty CoreExpr
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core a -> CoreExpr
forall a. Core a -> CoreExpr
unC NonEmpty (Core a)
xs))
coreStringLit :: MonadThings m => FastString -> m (Core String)
coreStringLit :: forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
s = do { CoreExpr
z <- FastString -> m CoreExpr
forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
mkStringExprFS FastString
s; Core String -> m (Core String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core String
forall a. CoreExpr -> Core a
MkC CoreExpr
z) }
repMaybe :: Name -> (a -> MetaM (Core b))
-> Maybe a -> MetaM (Core (Maybe b))
repMaybe :: forall a b.
Name -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
repMaybe Name
tc_name a -> MetaM (Core b)
f Maybe a
m = do
Type
t <- Name -> MetaM Type
lookupType Name
tc_name
Type -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
forall a b.
Type -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
repMaybeT Type
t a -> MetaM (Core b)
f Maybe a
m
repMaybeT :: Type -> (a -> MetaM (Core b))
-> Maybe a -> MetaM (Core (Maybe b))
repMaybeT :: forall a b.
Type -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
repMaybeT Type
ty a -> MetaM (Core b)
_ Maybe a
Nothing = Core (Maybe b) -> ReaderT MetaWrappers DsM (Core (Maybe b))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Core (Maybe b) -> ReaderT MetaWrappers DsM (Core (Maybe b)))
-> Core (Maybe b) -> ReaderT MetaWrappers DsM (Core (Maybe b))
forall a b. (a -> b) -> a -> b
$ Type -> Core (Maybe b)
forall a. Type -> Core (Maybe a)
coreNothing' Type
ty
repMaybeT Type
ty a -> MetaM (Core b)
f (Just a
es) = Type -> Core b -> Core (Maybe b)
forall a. Type -> Core a -> Core (Maybe a)
coreJust' Type
ty (Core b -> Core (Maybe b))
-> MetaM (Core b) -> ReaderT MetaWrappers DsM (Core (Maybe b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> MetaM (Core b)
f a
es
coreNothing :: Name
-> MetaM (Core (Maybe a))
coreNothing :: forall a. Name -> MetaM (Core (Maybe a))
coreNothing Name
tc_name =
do { Type
elt_ty <- Name -> MetaM Type
lookupType Name
tc_name; Core (Maybe a) -> MetaM (Core (Maybe a))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Core (Maybe a)
forall a. Type -> Core (Maybe a)
coreNothing' Type
elt_ty) }
coreNothingM :: Name -> MetaM (Core (Maybe a))
coreNothingM :: forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
tc_name =
do { Type
elt_ty <- Name -> MetaM Type
wrapName Name
tc_name; Core (Maybe a) -> MetaM (Core (Maybe a))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Core (Maybe a)
forall a. Type -> Core (Maybe a)
coreNothing' Type
elt_ty) }
coreNothing' :: Type
-> Core (Maybe a)
coreNothing' :: forall a. Type -> Core (Maybe a)
coreNothing' Type
elt_ty = CoreExpr -> Core (Maybe a)
forall a. CoreExpr -> Core a
MkC (Type -> CoreExpr
mkNothingExpr Type
elt_ty)
coreJust :: Name
-> Core a -> MetaM (Core (Maybe a))
coreJust :: forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJust Name
tc_name Core a
es
= do { Type
elt_ty <- Name -> MetaM Type
lookupType Name
tc_name; Core (Maybe a) -> MetaM (Core (Maybe a))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Core a -> Core (Maybe a)
forall a. Type -> Core a -> Core (Maybe a)
coreJust' Type
elt_ty Core a
es) }
coreJustM :: Name -> Core a -> MetaM (Core (Maybe a))
coreJustM :: forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJustM Name
tc_name Core a
es = do { Type
elt_ty <- Name -> MetaM Type
wrapName Name
tc_name; Core (Maybe a) -> MetaM (Core (Maybe a))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Core a -> Core (Maybe a)
forall a. Type -> Core a -> Core (Maybe a)
coreJust' Type
elt_ty Core a
es) }
coreJust' :: Type
-> Core a -> Core (Maybe a)
coreJust' :: forall a. Type -> Core a -> Core (Maybe a)
coreJust' Type
elt_ty Core a
es = CoreExpr -> Core (Maybe a)
forall a. CoreExpr -> Core a
MkC (Type -> CoreExpr -> CoreExpr
mkJustExpr Type
elt_ty (Core a -> CoreExpr
forall a. Core a -> CoreExpr
unC Core a
es))
coreJustList :: Type -> Core [a] -> Core (Maybe [a])
coreJustList :: forall a. Type -> Core [a] -> Core (Maybe [a])
coreJustList Type
elt_ty = Type -> Core [a] -> Core (Maybe [a])
forall a. Type -> Core a -> Core (Maybe a)
coreJust' (Type -> Type
mkListTy Type
elt_ty)
coreNothingList :: Type -> Core (Maybe [a])
coreNothingList :: forall a. Type -> Core (Maybe [a])
coreNothingList Type
elt_ty = Type -> Core (Maybe [a])
forall a. Type -> Core (Maybe a)
coreNothing' (Type -> Type
mkListTy Type
elt_ty)
coreIntLit :: Int -> MetaM (Core Int)
coreIntLit :: Int -> MetaM (Core Int)
coreIntLit Int
i = do Platform
platform <- MetaM Platform
getPlatform
Core Int -> MetaM (Core Int)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core Int
forall a. CoreExpr -> Core a
MkC (Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
i))
coreVar :: Id -> Core TH.Name
coreVar :: Id -> Core Name
coreVar Id
id = CoreExpr -> Core Name
forall a. CoreExpr -> Core a
MkC (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
id)
notHandledL :: SrcSpan -> ThRejectionReason -> MetaM a
notHandledL :: forall a. SrcSpan -> ThRejectionReason -> MetaM a
notHandledL SrcSpan
loc ThRejectionReason
reason
| SrcSpan -> Bool
isGoodSrcSpan SrcSpan
loc
= (IOEnv (Env DsGblEnv DsLclEnv) a
-> IOEnv (Env DsGblEnv DsLclEnv) a)
-> ReaderT MetaWrappers DsM a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (SrcSpan
-> IOEnv (Env DsGblEnv DsLclEnv) a
-> IOEnv (Env DsGblEnv DsLclEnv) a
forall a. SrcSpan -> DsM a -> DsM a
putSrcSpanDs SrcSpan
loc) (ReaderT MetaWrappers DsM a -> ReaderT MetaWrappers DsM a)
-> ReaderT MetaWrappers DsM a -> ReaderT MetaWrappers DsM a
forall a b. (a -> b) -> a -> b
$ ThRejectionReason -> ReaderT MetaWrappers DsM a
forall a. ThRejectionReason -> MetaM a
notHandled ThRejectionReason
reason
| Bool
otherwise
= ThRejectionReason -> ReaderT MetaWrappers DsM a
forall a. ThRejectionReason -> MetaM a
notHandled ThRejectionReason
reason
notHandled :: ThRejectionReason -> MetaM a
notHandled :: forall a. ThRejectionReason -> MetaM a
notHandled ThRejectionReason
reason = DsM a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => m a -> ReaderT MetaWrappers m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM a -> ReaderT MetaWrappers DsM a)
-> DsM a -> ReaderT MetaWrappers DsM a
forall a b. (a -> b) -> a -> b
$ DsMessage -> DsM a
forall a. DsMessage -> DsM a
failWithDs (ThRejectionReason -> DsMessage
DsNotYetHandledByTH ThRejectionReason
reason)