{-# LANGUAGE AllowAmbiguousTypes    #-}

{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiWayIf             #-}
{-# LANGUAGE PatternSynonyms        #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE UndecidableInstances   #-}

-----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 2006
--
-- The purpose of this module is to transform an HsExpr into a CoreExpr which
-- when evaluated, returns a (Meta.Q Meta.Exp) computation analogous to the
-- input HsExpr. We do this in the DsM monad, which supplies access to
-- CoreExpr's of the "smart constructors" of the Meta.Exp datatype.
--
-- It also defines a bunch of knownKeyNames, in the same way as is done
-- in prelude/GHC.Builtin.Names.  It's much more convenient to do it here, because
-- otherwise we have to recompile GHC.Builtin.Names whenever we add a Name, which is
-- a Royal Pain (triggers other recompilation).
-----------------------------------------------------------------------------

module GHC.HsToCore.Quote( dsBracket ) where

import GHC.Prelude
import GHC.Platform

import GHC.Driver.DynFlags

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 GHC.Boot.TH.Syntax as TH

import GHC.Hs

import GHC.Tc.Utils.TcType
import GHC.Tc.Types.Evidence
import GHC.Tc.TyCl ( IsPrefixConGADT(..), unannotatedMultIsLinear )

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.Builtin.Types.Prim

import GHC.Unit.Module

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Utils.Monad

import GHC.Data.FastString
import GHC.Data.Maybe
import qualified GHC.Data.List.NonEmpty as NE

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(..), toList )
import Data.Function
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import GHC.Types.Name.Reader (RdrName(..), WithUserRdr (..))

data MetaWrappers = MetaWrappers {
      -- Applies its argument to a type argument `m` and dictionary `Quote m`
      MetaWrappers -> CoreExpr -> CoreExpr
quoteWrapper :: CoreExpr -> CoreExpr
      -- Apply its argument to a type argument `m` and a dictionary `Monad m`
    , MetaWrappers -> CoreExpr -> CoreExpr
monadWrapper :: CoreExpr -> CoreExpr
      -- Apply the container typed variable `m` to the argument type `T` to get `m T`.
    , MetaWrappers -> Type -> Type
metaTy :: Type -> Type
      -- Information about the wrappers which be printed to be inspected
    , MetaWrappers -> (HsWrapper, HsWrapper, Type)
_debugWrappers :: (HsWrapper, HsWrapper, Type)
    }

-- | Construct the functions which will apply the relevant part of the
-- QuoteWrapper to identifiers during desugaring.
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
      -- Get the superclass selector to select the Monad dictionary, going
      -- to be used to construct the monadWrapper.
      quote_tc <- Name -> DsM TyCon
dsLookupTyCon Name
quoteClassName
      monad_tc <- dsLookupTyCon monadClassName
      let cls = Maybe Class -> Class
forall a. HasCallStack => Maybe a -> a
expectJust (Maybe Class -> Class) -> Maybe Class -> Class
forall a b. (a -> b) -> a -> b
$ TyCon -> Maybe Class
tyConClass_maybe TyCon
quote_tc
          monad_cls = Maybe Class -> Class
forall a. HasCallStack => Maybe a -> a
expectJust (Maybe Class -> Class) -> Maybe Class -> Class
forall a b. (a -> b) -> a -> b
$ TyCon -> Maybe Class
tyConClass_maybe TyCon
monad_tc
          -- Quote m -> Monad m
          monad_sel = Class -> Int -> Id
classSCSelId Class
cls Int
0

          -- Only used for the defensive assertion that the selector has
          -- the expected type
          tyvars = DataCon -> [InvisTVBinder]
dataConUserTyVarBinders (Class -> DataCon
classDataCon Class
cls)
          expected_ty = [InvisTVBinder] -> Type -> Type
mkInvisForAllTys [InvisTVBinder]
tyvars (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
                        HasDebugCallStack => 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)))

      massertPpr (idType monad_sel `eqType` expected_ty) (ppr monad_sel $$ ppr expected_ty)

      let m_ty = Type -> CoreExpr
forall b. Type -> Expr b
Type Type
m_var
          -- Construct the contents of MetaWrappers
          quoteWrapper = QuoteWrapper -> HsWrapper
applyQuoteWrapper QuoteWrapper
q
          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
t = Type -> Type -> Type
mkAppTy Type
m_var Type
t
          debug = (HsWrapper
quoteWrapper, HsWrapper
monadWrapper, Type
m_var)
      dsHsWrapper quoteWrapper $ \CoreExpr -> CoreExpr
q_f -> do {
      HsWrapper
-> ((CoreExpr -> CoreExpr) -> DsM MetaWrappers) -> DsM MetaWrappers
forall a. HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a
dsHsWrapper HsWrapper
monadWrapper (((CoreExpr -> CoreExpr) -> DsM MetaWrappers) -> DsM MetaWrappers)
-> ((CoreExpr -> CoreExpr) -> DsM MetaWrappers) -> DsM MetaWrappers
forall a b. (a -> b) -> a -> b
$ \CoreExpr -> CoreExpr
m_f -> do {
      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) } }

-- Turn A into m A
wrapName :: Name -> MetaM Type
wrapName :: Name -> MetaM Type
wrapName Name
n = do
  t <- Name -> MetaM Type
lookupType Name
n
  wrap_fn <- asks metaTy
  return (wrap_fn t)

-- The local state is always the same, calculated from the passed in
-- wrapper
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
-- See Note [Desugaring Brackets]
-- Returns a CoreExpr of type (M TH.Exp)
-- The quoted thing is parameterised over Name, even though it has
-- been type checked.  We don't want all those type decorations!

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 (GhcPass 'Renamed)
hsb_quote = HsQuote (GhcPass 'Renamed)
quote })
  = case HsQuote (GhcPass 'Renamed)
quote of
      VarBr XVarBr (GhcPass 'Renamed)
_ Bool
_ LIdP (GhcPass 'Renamed)
n -> do { MkC e1  <- Name -> DsM (Core Name)
lookupOccDsM (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
n) ; return e1 }
      ExpBr XExpBr (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
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 e1  <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e     ; return e1 }
      PatBr XPatBr (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
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 p1  <- LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repTopP LPat (GhcPass 'Renamed)
p   ; return p1 }
      TypBr XTypBr (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
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 t1  <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
t    ; return t1 }
      DecBrG XDecBrG (GhcPass 'Renamed)
_ HsGroup (GhcPass 'Renamed)
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 ds1 <- HsGroup (GhcPass 'Renamed) -> MetaM (Core (M [Dec]))
repTopDs HsGroup (GhcPass 'Renamed)
gp ; return ds1 }
      DecBrL {}   -> String -> DsM CoreExpr
forall a. HasCallStack => String -> a
panic String
"dsUntypedBracket: unexpected DecBrL"
  where
    wrap :: QuoteWrapper
wrap = Maybe QuoteWrapper -> QuoteWrapper
forall a. HasCallStack => Maybe a -> a
expectJust Maybe QuoteWrapper
mb_wrap  -- Not used in VarBr case
      -- In the overloaded case we have to get given a wrapper, it is just
      -- the VarBr case that there is no wrapper, because they
      -- have a simple type.

    runOverloaded :: ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded ReaderT MetaWrappers DsM CoreExpr
act = do { mw <- QuoteWrapper -> DsM MetaWrappers
mkMetaWrappers QuoteWrapper
wrap
                           ; runReaderT (mapReaderT (dsExtendMetaEnv new_bit) act) 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]

{-
Note [Desugaring Brackets]
~~~~~~~~~~~~~~~~~~~~~~~~~~

In the old days (pre Dec 2019) quotation brackets used to be monomorphic, ie
an expression bracket was of type Q Exp. This made the desugaring process simple
as there were no complicated type variables to keep consistent throughout the
whole AST. Due to the overloaded quotations proposal a quotation bracket is now
of type `Quote m => m Exp` and all the combinators defined in TH.Lib have been
generalised to work with any monad implementing a minimal interface.

https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0246-overloaded-bracket.rst

Users can rejoice at the flexibility but now there is some additional complexity in
how brackets are desugared as all these polymorphic combinators need their arguments
instantiated.

> IF YOU ARE MODIFYING THIS MODULE DO NOT USE ANYTHING SPECIFIC TO Q. INSTEAD
> USE THE `wrapName` FUNCTION TO APPLY THE `m` TYPE VARIABLE TO A TYPE CONSTRUCTOR.

What the arguments should be instantiated to is supplied by the `QuoteWrapper`
datatype which is produced by `GHC.Tc.Gen.Splice`. It is a pair of an evidence variable
for `Quote m` and a type variable `m`. All the polymorphic combinators in desugaring
need to be applied to these two type variables.

There are three important functions which do the application.

1. The default is `rep2` which takes a function name of type `Quote m => T` as an argument.
2. `rep2M` takes a function name of type `Monad m => T` as an argument
3. `rep2_nw` takes a function name without any constraints as an argument.

These functions then use the information in QuoteWrapper to apply the correct
arguments to the functions as the representation is constructed.

The `MetaM` monad carries around an environment of three functions which are
used in order to wrap the polymorphic combinators and instantiate the arguments
to the correct things.

1. quoteWrapper wraps functions of type `forall m . Quote m => T`
2. monadWrapper wraps functions of type `forall m . Monad m => T`
3. metaTy wraps a type in the polymorphic `m` variable of the whole representation.

Historical note about the implementation: At the first attempt, I attempted to
lie that the type of any quotation was `Quote m => m Exp` and then specialise it
by applying a wrapper to pass the `m` and `Quote m` arguments. This approach was
simpler to implement but didn't work because of nested splices. For example,
you might have a nested splice of a more specific type which fixes the type of
the overall quote and so all the combinators used must also be instantiated to
that specific type. Therefore you really have to use the contents of the quote
wrapper to directly apply the right type to the combinators rather than
first generate a polymorphic definition and then just apply the wrapper at the end.

-}

{- -------------- Examples --------------------

  [| \x -> x |]
====>
  gensym (unpackString "x"#) `bindQ` \ x1::String ->
  lam (pvar x1) (var x1)


  [| \x -> $(f [| x |]) |]
====>
  gensym (unpackString "x"#) `bindQ` \ x1::String ->
  lam (pvar x1) (f (var x1))
-}


-------------------------------------------------------
--                      Declarations
-------------------------------------------------------

-- Proxy for the phantom type of `Core`. All the generated fragments have
-- type something like `Quote m => m Exp` so to keep things simple we represent fragments
-- of that type as `M Exp`.
data M a

repTopP :: LPat GhcRn -> MetaM (Core (M TH.Pat))
repTopP :: LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repTopP LPat (GhcPass 'Renamed)
pat = do { ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms (CollectFlag (GhcPass 'Renamed)
-> LPat (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag (GhcPass 'Renamed)
forall p. CollectFlag p
CollNoDictBinders LPat (GhcPass 'Renamed)
pat)
                 ; pat' <- addBinds ss (repLP pat)
                 ; wrapGenSyms ss pat' }

repTopDs :: HsGroup GhcRn -> MetaM (Core (M [TH.Dec]))
repTopDs :: HsGroup (GhcPass 'Renamed) -> MetaM (Core (M [Dec]))
repTopDs group :: HsGroup (GhcPass 'Renamed)
group@(HsGroup { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds   = HsValBinds (GhcPass 'Renamed)
valds
                        , hs_splcds :: forall p. HsGroup p -> [LSpliceDecl p]
hs_splcds  = [LSpliceDecl (GhcPass 'Renamed)]
splcds
                        , hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds  = [TyClGroup (GhcPass 'Renamed)]
tyclds
                        , hs_derivds :: forall p. HsGroup p -> [LDerivDecl p]
hs_derivds = [LDerivDecl (GhcPass 'Renamed)]
derivds
                        , hs_fixds :: forall p. HsGroup p -> [LFixitySig p]
hs_fixds   = [LFixitySig (GhcPass 'Renamed)]
fixds
                        , hs_defds :: forall p. HsGroup p -> [LDefaultDecl p]
hs_defds   = [LDefaultDecl (GhcPass 'Renamed)]
defds
                        , hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
hs_fords   = [LForeignDecl (GhcPass 'Renamed)]
fords
                        , hs_warnds :: forall p. HsGroup p -> [LWarnDecls p]
hs_warnds  = [LWarnDecls (GhcPass 'Renamed)]
warnds
                        , hs_annds :: forall p. HsGroup p -> [LAnnDecl p]
hs_annds   = [LAnnDecl (GhcPass 'Renamed)]
annds
                        , hs_ruleds :: forall p. HsGroup p -> [LRuleDecls p]
hs_ruleds  = [LRuleDecls (GhcPass 'Renamed)]
ruleds
                        , hs_docs :: forall p. HsGroup p -> [LDocDecl p]
hs_docs    = [LDocDecl (GhcPass 'Renamed)]
docs })
 = do { let { bndrs :: [Name]
bndrs  = HsValBinds (GhcPass 'Renamed) -> [Name]
hsScopedTvBinders HsValBinds (GhcPass 'Renamed)
valds
                       [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ HsGroup (GhcPass 'Renamed) -> [Name]
hsGroupBinders HsGroup (GhcPass 'Renamed)
group
                       [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FieldOcc (GhcPass 'Renamed) -> Name)
-> [FieldOcc (GhcPass 'Renamed)] -> [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)
-> (FieldOcc (GhcPass 'Renamed) -> GenLocated SrcSpanAnnN Name)
-> FieldOcc (GhcPass 'Renamed)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc (GhcPass 'Renamed) -> LIdP (GhcPass 'Renamed)
FieldOcc (GhcPass 'Renamed) -> GenLocated SrcSpanAnnN Name
forall pass. FieldOcc pass -> LIdP pass
foLabel) (HsValBinds (GhcPass 'Renamed) -> [FieldOcc (GhcPass 'Renamed)]
forall (p :: Pass).
IsPass p =>
HsValBinds (GhcPass p) -> [FieldOcc (GhcPass p)]
hsPatSynSelectors HsValBinds (GhcPass 'Renamed)
valds)
            ; instds :: [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))]
instds = [TyClGroup (GhcPass 'Renamed)]
tyclds [TyClGroup (GhcPass 'Renamed)]
-> (TyClGroup (GhcPass 'Renamed)
    -> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))])
-> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TyClGroup (GhcPass 'Renamed) -> [LInstDecl (GhcPass 'Renamed)]
TyClGroup (GhcPass 'Renamed)
-> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))]
forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds } ;
        ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
bndrs ;

        -- Bind all the names mainly to avoid repeated use of explicit strings.
        -- Thus we get
        --      do { t :: String <- genSym "T" ;
        --           return (Data t [] ...more t's... }
        -- The other important reason is that the output must mention
        -- only "T", not "Foo:T" where Foo is the current module

        decls <- addBinds ss (
                  do { val_ds   <- rep_val_binds valds
                     ; _        <- mapM no_splice splcds
                     ; tycl_ds  <- mapM repTyClD (tyClGroupTyClDecls tyclds)
                     ; role_ds  <- mapM repRoleD (concatMap group_roles tyclds)
                     ; kisig_ds <- mapM repKiSigD (concatMap group_kisigs tyclds)
                     ; inst_ds  <- mapM repInstD instds
                     ; deriv_ds <- mapM repStandaloneDerivD derivds
                     ; fix_ds   <- mapM repLFixD fixds
                     ; def_ds   <- mapM repDefD defds
                     ; for_ds   <- mapM repForD fords
                     ; _        <- mapM no_warn (concatMap (wd_warnings . unLoc)
                                                           warnds)
                     ; ann_ds   <- mapM repAnnD annds
                     ; rule_ds  <- mapM repRuleD (concatMap (rds_rules . unLoc)
                                                            ruleds)
                     ; _        <- mapM no_doc docs

                        -- more needed
                     ;  return (de_loc $ sort_by_loc $
                                val_ds ++ catMaybes tycl_ds ++ role_ds
                                       ++ kisig_ds
                                       ++ (concat fix_ds)
                                       ++ def_ds
                                       ++ inst_ds ++ rule_ds ++ for_ds
                                       ++ ann_ds ++ deriv_ds) }) ;

        core_list <- repListM decTyConName return decls ;

        dec_ty <- lookupType decTyConName ;
        q_decs  <- repSequenceM dec_ty core_list ;

        wrapGenSyms ss q_decs
      }
  where
    no_splice :: GenLocated a e -> MetaM a
no_splice (L a
loc e
_)
      = SrcSpan -> ThRejectionReason -> MetaM a
forall a. SrcSpan -> ThRejectionReason -> MetaM a
notHandledL (a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
loc) ThRejectionReason
ThSplicesWithinDeclBrackets
    no_warn :: LWarnDecl GhcRn -> MetaM a
    no_warn :: forall a. LWarnDecl (GhcPass 'Renamed) -> MetaM a
no_warn (L SrcSpanAnnA
loc (Warning XWarning (GhcPass 'Renamed)
_ [LIdP (GhcPass 'Renamed)]
thing WarningTxt (GhcPass 'Renamed)
_))
      = SrcSpan -> ThRejectionReason -> MetaM a
forall a. SrcSpan -> ThRejectionReason -> MetaM a
notHandledL (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) ([LIdP (GhcPass 'Renamed)] -> ThRejectionReason
ThWarningAndDeprecationPragmas [LIdP (GhcPass 'Renamed)]
thing)
    no_doc :: GenLocated a e -> MetaM a
no_doc (L a
loc e
_)
      = SrcSpan -> ThRejectionReason -> MetaM a
forall a. SrcSpan -> ThRejectionReason -> MetaM a
notHandledL (a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
loc) ThRejectionReason
ThHaddockDocumentation

hsScopedTvBinders :: HsValBinds GhcRn -> [Name]
-- See Note [Scoped type variables in quotes]
hsScopedTvBinders :: HsValBinds (GhcPass 'Renamed) -> [Name]
hsScopedTvBinders HsValBinds (GhcPass 'Renamed)
binds
  = (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> [Name])
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LSig (GhcPass 'Renamed) -> [Name]
GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> [Name]
get_scoped_tvs [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
sigs
  where
    sigs :: [LSig (GhcPass 'Renamed)]
sigs = case HsValBinds (GhcPass 'Renamed)
binds of
             ValBinds           XValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
_ LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
_ [LSig (GhcPass 'Renamed)]
sigs  -> [LSig (GhcPass 'Renamed)]
sigs
             XValBindsLR (NValBinds [(RecFlag, LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
_ [LSig (GhcPass 'Renamed)]
sigs) -> [LSig (GhcPass 'Renamed)]
sigs

get_scoped_tvs :: LSig GhcRn -> [Name]
get_scoped_tvs :: LSig (GhcPass 'Renamed) -> [Name]
get_scoped_tvs (L SrcSpanAnnA
_ Sig (GhcPass 'Renamed)
signature)
  | TypeSig XTypeSig (GhcPass 'Renamed)
_ [LIdP (GhcPass 'Renamed)]
_ LHsSigWcType (GhcPass 'Renamed)
sig <- Sig (GhcPass 'Renamed)
signature
  = LHsSigType (GhcPass 'Renamed) -> [Name]
get_scoped_tvs_from_sig (HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsSigWcType (GhcPass 'Renamed)
HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
sig)
  | ClassOpSig XClassOpSig (GhcPass 'Renamed)
_ Bool
_ [LIdP (GhcPass 'Renamed)]
_ LHsSigType (GhcPass 'Renamed)
sig <- Sig (GhcPass 'Renamed)
signature
  = LHsSigType (GhcPass 'Renamed) -> [Name]
get_scoped_tvs_from_sig LHsSigType (GhcPass 'Renamed)
sig
  | PatSynSig XPatSynSig (GhcPass 'Renamed)
_ [LIdP (GhcPass 'Renamed)]
_ LHsSigType (GhcPass 'Renamed)
sig <- Sig (GhcPass 'Renamed)
signature
  = LHsSigType (GhcPass 'Renamed) -> [Name]
get_scoped_tvs_from_sig LHsSigType (GhcPass 'Renamed)
sig
  | Bool
otherwise
  = []

get_scoped_tvs_from_sig :: LHsSigType GhcRn -> [Name]
  -- Collect both implicit and explicit quantified variables, since
  -- the types in instance heads, as well as `via` types in DerivingVia, can
  -- bring implicitly quantified type variables into scope, e.g.,
  --
  --   instance Foo [a] where
  --     m = n @a
  --
  -- See also Note [Scoped type variables in quotes]
get_scoped_tvs_from_sig :: LHsSigType (GhcPass 'Renamed) -> [Name]
get_scoped_tvs_from_sig (L SrcSpanAnnA
_ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs})) =
  HsOuterSigTyVarBndrs (GhcPass 'Renamed) -> [Name]
forall flag. HsOuterTyVarBndrs flag (GhcPass 'Renamed) -> [Name]
hsOuterTyVarNames HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs

{- Notes

Note [Scoped type variables in quotes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Quoting declarations with scoped type variables requires some care. Consider:

  $([d| f :: forall a. a -> a
        f x = x::a
      |])

Here, the `forall a` brings `a` into scope over the binding group. This has
ramifications when desugaring the quote, as we must ensure that that the
desugared code binds `a` with `Language.Haskell.TH.newName` and refers to the
bound `a` type variable in the type signature and in the body of `f`. As a
result, the call to `newName` must occur before any part of the declaration for
`f` is processed. To achieve this, we:

 (a) Gensym a binding for `a` at the same time as we do one for `f`,
     collecting the relevant binders with the hsScopedTvBinders family of
     functions.

 (b) Use `addBinds` to bring these gensymmed bindings into scope over any
     part of the code where the type variables scope. In the `f` example,
     above, that means the type signature and the body of `f`.

 (c) When processing the `forall`, /don't/ gensym the type variables. We have
     already brought the type variables into scope in part (b), after all, so
     gensymming them again would lead to shadowing. We use the rep_ty_sig
     family of functions for processing types without gensymming the type
     variables again.

 (d) Finally, we use wrapGenSyms to generate the Core for these scoped type
     variables:

       newName "a" >>= \a ->
         ... -- process the type signature and body of `f`

The relevant places are signposted with references to this Note.

Note [Binders and occurrences]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we desugar [d| data T = MkT |]
we want to get
        Data "T" [] [Con "MkT" []] []
and *not*
        Data "Foo:T" [] [Con "Foo:MkT" []] []
That is, the new data decl should fit into whatever new module it is
asked to fit in.   We do *not* clone, though; no need for this:
        Data "T79" ....

But if we see this:
        data T = MkT
        foo = reifyDecl T

then we must desugar to
        foo = Data "Foo:T" [] [Con "Foo:MkT" []] []

So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
And we use lookupOcc, rather than lookupBinder
in repTyClD and repC.

Note [Don't quantify implicit type variables in quotes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If you're not careful, it's surprisingly easy to take this quoted declaration:

  [d| id :: a -> a
      id x = x
    |]

and have Template Haskell turn it into this:

  id :: forall a. a -> a
  id x = x

Notice that we explicitly quantified the variable `a`! The latter declaration
isn't what the user wrote in the first place.

Usually, the culprit behind these bugs is taking implicitly quantified type
variables (often from the hsib_vars field of HsImplicitBinders) and putting
them into a `ForallT` or `ForallC`. Doing so caused #13018 and #13123.
-}

-- represent associated family instances
--
repTyClD :: LTyClDecl GhcRn -> MetaM (Maybe (SrcSpan, Core (M TH.Dec)))

repTyClD :: LTyClDecl (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
repTyClD (L SrcSpanAnnA
loc (FamDecl { tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam = FamilyDecl (GhcPass 'Renamed)
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 (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repFamilyDecl (SrcSpanAnnA
-> FamilyDecl (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc FamilyDecl (GhcPass 'Renamed)
fam)

repTyClD (L SrcSpanAnnA
loc (SynDecl { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP (GhcPass 'Renamed)
tc, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars (GhcPass 'Renamed)
tvs, tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LHsType (GhcPass 'Renamed)
rhs }))
  = do { tc1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
tc           -- See Note [Binders and occurrences]
       ; dec <- addQTyVarBinds ReuseBoundNames tvs $ \Core [M (TyVarBndr BndrVis)]
bndrs ->
                Core Name
-> Core [M (TyVarBndr BndrVis)]
-> LHsType (GhcPass 'Renamed)
-> MetaM (Core (M Dec))
repSynDecl Core Name
tc1 Core [M (TyVarBndr BndrVis)]
bndrs LHsType (GhcPass 'Renamed)
rhs
       ; return (Just (locA loc, dec)) }

repTyClD (L SrcSpanAnnA
loc (DataDecl { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP (GhcPass 'Renamed)
tc
                          , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars (GhcPass 'Renamed)
tvs
                          , tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn (GhcPass 'Renamed)
defn }))
  = do { tc1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
tc           -- See Note [Binders and occurrences]
       ; dec <- addQTyVarBinds ReuseBoundNames tvs $ \Core [M (TyVarBndr BndrVis)]
bndrs ->
                Core Name
-> Either
     (Core [M (TyVarBndr BndrVis)])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> HsDataDefn (GhcPass 'Renamed)
-> MetaM (Core (M Dec))
repDataDefn Core Name
tc1 (Core [M (TyVarBndr BndrVis)]
-> Either
     (Core [M (TyVarBndr BndrVis)])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
forall a b. a -> Either a b
Left Core [M (TyVarBndr BndrVis)]
bndrs) HsDataDefn (GhcPass 'Renamed)
defn
       ; return (Just (locA loc, dec)) }

repTyClD (L SrcSpanAnnA
loc (ClassDecl { tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCtxt = Maybe (LHsContext (GhcPass 'Renamed))
cxt, tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP (GhcPass 'Renamed)
cls,
                             tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars (GhcPass 'Renamed)
tvs, tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdFDs = [LHsFunDep (GhcPass 'Renamed)]
fds,
                             tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig (GhcPass 'Renamed)]
sigs, tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths = LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
meth_binds,
                             tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs = [LFamilyDecl (GhcPass 'Renamed)]
ats, tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs = [LTyFamDefltDecl (GhcPass 'Renamed)]
atds }))
  = do { cls1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
cls         -- See Note [Binders and occurrences]
       ; dec  <- addQTyVarBinds FreshNamesOnly tvs $ \Core [M (TyVarBndr BndrVis)]
bndrs ->
           do { cxt1   <- Maybe (LHsContext (GhcPass 'Renamed)) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext (GhcPass 'Renamed))
cxt
          -- See Note [Scoped type variables in quotes]
              ; (ss, sigs_binds) <- rep_meth_sigs_binds sigs meth_binds
              ; fds1   <- repLFunDeps fds
              ; ats1   <- repFamilyDecls ats
              ; atds1  <- mapM (repAssocTyFamDefaultD . unLoc) atds
              ; decls1 <- repListM decTyConName return (ats1 ++ atds1 ++ sigs_binds)
              ; decls2 <- repClass cxt1 cls1 bndrs fds1 decls1
              ; wrapGenSyms ss decls2 }
       ; return $ Just (locA loc, dec)
       }

-------------------------
repRoleD :: LRoleAnnotDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repRoleD :: LRoleAnnotDecl (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRoleD (L SrcSpanAnnA
loc (RoleAnnotDecl XCRoleAnnotDecl (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
tycon [XRec (GhcPass 'Renamed) (Maybe Role)]
roles))
  = do { tycon1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
tycon
       ; roles1 <- mapM repRole roles
       ; roles2 <- coreList roleTyConName roles1
       ; dec <- repRoleAnnotD tycon1 roles2
       ; return (locA loc, dec) }

-------------------------
repKiSigD :: LStandaloneKindSig GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repKiSigD :: LStandaloneKindSig (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repKiSigD (L SrcSpanAnnA
loc StandaloneKindSig (GhcPass 'Renamed)
kisig) =
  case StandaloneKindSig (GhcPass 'Renamed)
kisig of
    StandaloneKindSig XStandaloneKindSig (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
v LHsSigType (GhcPass 'Renamed)
ki -> do
      MkC th_v  <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
v
      MkC th_ki <- repHsSigType ki
      dec       <- rep2 kiSigDName [th_v, th_ki]
      pure (locA loc, dec)

-------------------------
repDataDefn :: Core TH.Name
            -> Either (Core [(M (TH.TyVarBndr TH.BndrVis))])
                        -- the repTyClD case
                      (Core (Maybe [(M (TH.TyVarBndr ()))]), Core (M TH.Type))
                        -- the repDataFamInstD case
            -> HsDataDefn GhcRn
            -> MetaM (Core (M TH.Dec))
repDataDefn :: Core Name
-> Either
     (Core [M (TyVarBndr BndrVis)])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> HsDataDefn (GhcPass 'Renamed)
-> MetaM (Core (M Dec))
repDataDefn Core Name
tc Either
  (Core [M (TyVarBndr BndrVis)])
  (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
opts
          (HsDataDefn { dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ctxt = Maybe (LHsContext (GhcPass 'Renamed))
cxt, dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (LHsType (GhcPass 'Renamed))
ksig
                      , dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons = DataDefnCons (LConDecl (GhcPass 'Renamed))
cons, dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs = HsDeriving (GhcPass 'Renamed)
mb_derivs })
  = do { cxt1     <- Maybe (LHsContext (GhcPass 'Renamed)) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext (GhcPass 'Renamed))
cxt
       ; derivs1  <- repDerivs mb_derivs
       ; case cons of
           NewTypeCon LConDecl (GhcPass 'Renamed)
con  -> do { con'  <- LConDecl (GhcPass 'Renamed) -> MetaM (Core (M Con))
repC LConDecl (GhcPass 'Renamed)
con
                                   ; ksig' <- repMaybeLTy ksig
                                   ; repNewtype cxt1 tc opts ksig' con'
                                                derivs1 }
           DataTypeCons Bool
type_data [LConDecl (GhcPass 'Renamed)]
cons -> do { ksig' <- Maybe (LHsType (GhcPass 'Renamed)) -> MetaM (Core (Maybe (M Type)))
repMaybeLTy Maybe (LHsType (GhcPass 'Renamed))
ksig
                               ; consL <- mapM repC cons
                               ; cons1 <- coreListM conTyConName consL
                               ; repData type_data cxt1 tc opts ksig' cons1
                                         derivs1 }
       }

repSynDecl :: Core TH.Name -> Core [(M (TH.TyVarBndr TH.BndrVis))]
           -> LHsType GhcRn
           -> MetaM (Core (M TH.Dec))
repSynDecl :: Core Name
-> Core [M (TyVarBndr BndrVis)]
-> LHsType (GhcPass 'Renamed)
-> MetaM (Core (M Dec))
repSynDecl Core Name
tc Core [M (TyVarBndr BndrVis)]
bndrs LHsType (GhcPass 'Renamed)
ty
  = do { ty1 <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
ty
       ; repTySyn tc bndrs ty1 }

repFamilyDecl :: LFamilyDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repFamilyDecl :: LFamilyDecl (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repFamilyDecl decl :: LFamilyDecl (GhcPass 'Renamed)
decl@(L SrcSpanAnnA
loc (FamilyDecl { fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo      = FamilyInfo (GhcPass 'Renamed)
info
                                      , fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName     = LIdP (GhcPass 'Renamed)
tc
                                      , fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars    = LHsQTyVars (GhcPass 'Renamed)
tvs
                                      , fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdResultSig = L EpAnnCO
_ FamilyResultSig (GhcPass 'Renamed)
resultSig
                                      , fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn (GhcPass 'Renamed))
injectivity }))
  = do { tc1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
tc           -- See Note [Binders and occurrences]
       ; let res_tv = FamilyResultSig (GhcPass 'Renamed)
-> Maybe (IdP (GhcPass 'Renamed))
forall (a :: Pass).
FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))
resultVariableName FamilyResultSig (GhcPass 'Renamed)
resultSig
       ; dec <- addQTyVarBinds ReuseBoundNames tvs $ \Core [M (TyVarBndr BndrVis)]
bndrs ->
                FreshOrReuse
-> [Name] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall {k} (a :: k).
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
ReuseBoundNames (Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList Maybe (IdP (GhcPass 'Renamed))
Maybe Name
res_tv) (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 (GhcPass 'Renamed)
info of
             ClosedTypeFamily Maybe [LTyFamInstEqn (GhcPass 'Renamed)]
Nothing ->
                 ThRejectionReason -> MetaM (Core (M Dec))
forall a. ThRejectionReason -> MetaM a
notHandled (LFamilyDecl (GhcPass 'Renamed) -> ThRejectionReason
ThAbstractClosedTypeFamily LFamilyDecl (GhcPass 'Renamed)
decl)
             ClosedTypeFamily (Just [LTyFamInstEqn (GhcPass 'Renamed)]
eqns) ->
               do { eqns1  <- (GenLocated
   SrcSpanAnnA
   (FamEqn
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))))
 -> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> [GenLocated
      SrcSpanAnnA
      (FamEqn
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))))]
-> 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 (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
FamEqn
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTyFamEqn (FamEqn
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
 -> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> (GenLocated
      SrcSpanAnnA
      (FamEqn
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))))
    -> FamEqn
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))))
-> GenLocated
     SrcSpanAnnA
     (FamEqn
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (FamEqn
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))))
-> FamEqn
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
forall l e. GenLocated l e -> e
unLoc) [LTyFamInstEqn (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA
   (FamEqn
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))))]
eqns
                  ; eqns2  <- coreListM tySynEqnTyConName eqns1
                  ; result <- repFamilyResultSig resultSig
                  ; inj    <- repInjectivityAnn injectivity
                  ; repClosedFamilyD tc1 bndrs result inj eqns2 }
             FamilyInfo (GhcPass 'Renamed)
OpenTypeFamily ->
               do { result <- FamilyResultSig (GhcPass 'Renamed)
-> MetaM (Core (M FamilyResultSig))
repFamilyResultSig FamilyResultSig (GhcPass 'Renamed)
resultSig
                  ; inj    <- repInjectivityAnn injectivity
                  ; repOpenFamilyD tc1 bndrs result inj }
             FamilyInfo (GhcPass 'Renamed)
DataFamily ->
               do { kind <- FamilyResultSig (GhcPass 'Renamed) -> MetaM (Core (Maybe (M Type)))
repFamilyResultSigToMaybeKind FamilyResultSig (GhcPass 'Renamed)
resultSig
                  ; repDataFamilyD tc1 bndrs kind }
       ; return (locA loc, dec)
       }

-- | Represent result signature of a type family
repFamilyResultSig :: FamilyResultSig GhcRn -> MetaM (Core (M TH.FamilyResultSig))
repFamilyResultSig :: FamilyResultSig (GhcPass 'Renamed)
-> MetaM (Core (M FamilyResultSig))
repFamilyResultSig (NoSig XNoSig (GhcPass 'Renamed)
_)         = MetaM (Core (M FamilyResultSig))
repNoSig
repFamilyResultSig (KindSig XCKindSig (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
ki)    = do { ki' <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
ki
                                          ; repKindSig ki' }
repFamilyResultSig (TyVarSig XTyVarSig (GhcPass 'Renamed)
_ LHsTyVarBndr () (GhcPass 'Renamed)
bndr) = do { bndr' <- LHsTyVarBndr () (GhcPass 'Renamed)
-> MetaM (Core (M (TyVarBndr ())))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag (GhcPass 'Renamed)
-> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr LHsTyVarBndr () (GhcPass 'Renamed)
bndr
                                          ; repTyVarSig bndr' }

-- | Represent result signature using a Maybe Kind. Used with data families,
-- where the result signature can be either missing or a kind but never a named
-- result variable.
repFamilyResultSigToMaybeKind :: FamilyResultSig GhcRn
                              -> MetaM (Core (Maybe (M TH.Kind)))
repFamilyResultSigToMaybeKind :: FamilyResultSig (GhcPass 'Renamed) -> MetaM (Core (Maybe (M Type)))
repFamilyResultSigToMaybeKind (NoSig XNoSig (GhcPass 'Renamed)
_) =
    Name -> MetaM (Core (Maybe (M Type)))
forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
kindTyConName
repFamilyResultSigToMaybeKind (KindSig XCKindSig (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
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
=<< LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
ki
repFamilyResultSigToMaybeKind TyVarSig{} =
    String -> MetaM (Core (Maybe (M Type)))
forall a. HasCallStack => String -> a
panic String
"repFamilyResultSigToMaybeKind: unexpected TyVarSig"

-- | Represent injectivity annotation of a type family
repInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
                  -> MetaM (Core (Maybe TH.InjectivityAnn))
repInjectivityAnn :: Maybe (LInjectivityAnn (GhcPass 'Renamed))
-> MetaM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn (GhcPass 'Renamed))
Nothing =
    Name -> MetaM (Core (Maybe InjectivityAnn))
forall a. Name -> MetaM (Core (Maybe a))
coreNothing Name
injAnnTyConName
repInjectivityAnn (Just (L EpAnnCO
_ (InjectivityAnn XCInjectivityAnn (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
lhs [LIdP (GhcPass 'Renamed)]
rhs))) =
    do { lhs'   <- Name -> MetaM (Core Name)
lookupBinder (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
lhs)
       ; rhs1   <- mapM (lookupBinder . unLoc) rhs
       ; rhs2   <- coreList nameTyConName rhs1
       ; injAnn <- rep2_nw injectivityAnnName [unC lhs', unC rhs2]
       ; coreJust injAnnTyConName injAnn }

repFamilyDecls :: [LFamilyDecl GhcRn] -> MetaM [Core (M TH.Dec)]
repFamilyDecls :: [LFamilyDecl (GhcPass 'Renamed)] -> MetaM [Core (M Dec)]
repFamilyDecls [LFamilyDecl (GhcPass 'Renamed)]
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 (GhcPass 'Renamed))
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Renamed))]
-> 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 (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repFamilyDecl [LFamilyDecl (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Renamed))]
fds)

repAssocTyFamDefaultD :: TyFamDefltDecl GhcRn -> MetaM (Core (M TH.Dec))
repAssocTyFamDefaultD :: TyFamDefltDecl (GhcPass 'Renamed) -> MetaM (Core (M Dec))
repAssocTyFamDefaultD = TyFamDefltDecl (GhcPass 'Renamed) -> MetaM (Core (M Dec))
repTyFamInstD

-------------------------
-- represent fundeps
--
repLFunDeps :: [LHsFunDep GhcRn] -> MetaM (Core [TH.FunDep])
repLFunDeps :: [LHsFunDep (GhcPass 'Renamed)] -> MetaM (Core [FunDep])
repLFunDeps [LHsFunDep (GhcPass 'Renamed)]
fds = Name
-> (GenLocated SrcSpanAnnA (FunDep (GhcPass 'Renamed))
    -> MetaM (Core FunDep))
-> [GenLocated SrcSpanAnnA (FunDep (GhcPass 'Renamed))]
-> MetaM (Core [FunDep])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
funDepTyConName LHsFunDep (GhcPass 'Renamed) -> MetaM (Core FunDep)
GenLocated SrcSpanAnnA (FunDep (GhcPass 'Renamed))
-> MetaM (Core FunDep)
repLFunDep [LHsFunDep (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (FunDep (GhcPass 'Renamed))]
fds

repLFunDep :: LHsFunDep GhcRn -> MetaM (Core TH.FunDep)
repLFunDep :: LHsFunDep (GhcPass 'Renamed) -> MetaM (Core FunDep)
repLFunDep (L SrcSpanAnnA
_ (FunDep XCFunDep (GhcPass 'Renamed)
_ [LIdP (GhcPass 'Renamed)]
xs [LIdP (GhcPass 'Renamed)]
ys))
   = do 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 (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
xs
        ys' <- repList nameTyConName (lookupBinder . unLoc) ys
        repFunDep xs' ys'

-- Represent instance declarations
--
repInstD :: LInstDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repInstD :: LInstDecl (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repInstD (L SrcSpanAnnA
loc (TyFamInstD { tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
tfid_inst = TyFamDefltDecl (GhcPass 'Renamed)
fi_decl }))
  = do { dec <- TyFamDefltDecl (GhcPass 'Renamed) -> MetaM (Core (M Dec))
repTyFamInstD TyFamDefltDecl (GhcPass 'Renamed)
fi_decl
       ; return (locA loc, dec) }
repInstD (L SrcSpanAnnA
loc (DataFamInstD { dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst = DataFamInstDecl (GhcPass 'Renamed)
fi_decl }))
  = do { dec <- DataFamInstDecl (GhcPass 'Renamed) -> MetaM (Core (M Dec))
repDataFamInstD DataFamInstDecl (GhcPass 'Renamed)
fi_decl
       ; return (locA loc, dec) }
repInstD (L SrcSpanAnnA
loc (ClsInstD { cid_inst :: forall pass. InstDecl pass -> ClsInstDecl pass
cid_inst = ClsInstDecl (GhcPass 'Renamed)
cls_decl }))
  = do { dec <- ClsInstDecl (GhcPass 'Renamed) -> MetaM (Core (M Dec))
repClsInstD ClsInstDecl (GhcPass 'Renamed)
cls_decl
       ; return (locA loc, dec) }

repClsInstD :: ClsInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repClsInstD :: ClsInstDecl (GhcPass 'Renamed) -> MetaM (Core (M Dec))
repClsInstD (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType (GhcPass 'Renamed)
ty, cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds = LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
binds
                         , cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_sigs = [LSig (GhcPass 'Renamed)]
sigs, cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts = [LTyFamDefltDecl (GhcPass 'Renamed)]
ats
                         , cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts = [LDataFamInstDecl (GhcPass 'Renamed)]
adts
                         , cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (XRec pass OverlapMode)
cid_overlap_mode = Maybe (XRec (GhcPass 'Renamed) OverlapMode)
overlap
                         })
  = FreshOrReuse
-> [Name] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall {k} (a :: k).
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
$
            -- We must bring the type variables into scope, so their
            -- occurrences don't fail, even though the binders don't
            -- appear in the resulting data structure
            --
            -- But we do NOT bring the binders of 'binds' into scope
            -- because they are properly regarded as occurrences
            -- For example, the method names should be bound to
            -- the selector Ids, not to fresh names (#5410)
            --
            do { cxt1     <- Maybe (LHsContext (GhcPass 'Renamed)) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext (GhcPass 'Renamed))
cxt
               ; inst_ty1 <- repLTy inst_ty
          -- See Note [Scoped type variables in quotes]
               ; (ss, sigs_binds) <- rep_meth_sigs_binds sigs binds
               ; ats1   <- mapM (repTyFamInstD . unLoc) ats
               ; adts1  <- mapM (repDataFamInstD . unLoc) adts
               ; decls1 <- coreListM decTyConName (ats1 ++ adts1 ++ sigs_binds)
               ; rOver  <- repOverlap (fmap unLoc overlap)
               ; decls2 <- repInst rOver cxt1 inst_ty1 decls1
               ; wrapGenSyms ss decls2 }
 where
   ([Name]
tvs, Maybe (LHsContext (GhcPass 'Renamed))
cxt, LHsType (GhcPass 'Renamed)
inst_ty) = LHsSigType (GhcPass 'Renamed)
-> ([Name], Maybe (LHsContext (GhcPass 'Renamed)),
    LHsType (GhcPass 'Renamed))
splitLHsInstDeclTy LHsSigType (GhcPass 'Renamed)
ty

repStandaloneDerivD :: LDerivDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repStandaloneDerivD :: LDerivDecl (GhcPass 'Renamed)
-> 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 (GhcPass 'Renamed))
strat
                                       , deriv_type :: forall pass. DerivDecl pass -> LHsSigWcType pass
deriv_type     = LHsSigWcType (GhcPass 'Renamed)
ty }))
  = do { dec <- Maybe (LDerivStrategy (GhcPass 'Renamed))
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall {k} (a :: k).
Maybe (LDerivStrategy (GhcPass 'Renamed))
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy Maybe (LDerivStrategy (GhcPass 'Renamed))
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 {k} (a :: k).
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 { cxt'     <- Maybe (LHsContext (GhcPass 'Renamed)) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext (GhcPass 'Renamed))
cxt
                   ; inst_ty' <- repLTy inst_ty
                   ; repDeriv strat' cxt' inst_ty' }
       ; return (locA loc, dec) }
  where
    ([Name]
tvs, Maybe (LHsContext (GhcPass 'Renamed))
cxt, LHsType (GhcPass 'Renamed)
inst_ty) = LHsSigType (GhcPass 'Renamed)
-> ([Name], Maybe (LHsContext (GhcPass 'Renamed)),
    LHsType (GhcPass 'Renamed))
splitLHsInstDeclTy (LHsSigWcType (GhcPass 'Renamed) -> LHsSigType (GhcPass 'Renamed)
forall (p :: Pass).
LHsSigWcType (GhcPass p) -> LHsSigType (GhcPass p)
dropWildCards LHsSigWcType (GhcPass 'Renamed)
ty)

repTyFamInstD :: TyFamInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repTyFamInstD :: TyFamDefltDecl (GhcPass 'Renamed) -> MetaM (Core (M Dec))
repTyFamInstD (TyFamInstDecl { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn = TyFamInstEqn (GhcPass 'Renamed)
eqn })
  = do { eqn1 <- TyFamInstEqn (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTyFamEqn TyFamInstEqn (GhcPass 'Renamed)
eqn
       ; repTySynInst eqn1 }

repTyFamEqn :: TyFamInstEqn GhcRn -> MetaM (Core (M TH.TySynEqn))
repTyFamEqn :: TyFamInstEqn (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTyFamEqn (FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = LIdP (GhcPass 'Renamed)
tc_name
                    , feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_bndrs = HsOuterFamEqnTyVarBndrs (GhcPass 'Renamed)
outer_bndrs
                    , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_pats = HsFamEqnPats (GhcPass 'Renamed)
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  = LHsType (GhcPass 'Renamed)
rhs })
  = do { tc <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
tc_name     -- See Note [Binders and occurrences]
       ; addHsOuterFamEqnTyVarBinds outer_bndrs $ \Core (Maybe [M (TyVarBndr ())])
mb_exp_bndrs ->
         do { tys1 <- case LexicalFixity
fixity of
                        LexicalFixity
Prefix -> MetaM (Core (M Type))
-> HsFamEqnPats (GhcPass 'Renamed) -> MetaM (Core (M Type))
repTyArgs (Core Name -> MetaM (Core (M Type))
repNamedTyCon Core Name
tc) HsFamEqnPats (GhcPass 'Renamed)
tys
                        LexicalFixity
Infix  -> do { (HsValArg _ t1: HsValArg _ t2: args) <- HsFamEqnPats (GhcPass 'Renamed)
-> MetaM (HsFamEqnPats (GhcPass 'Renamed))
checkTys HsFamEqnPats (GhcPass 'Renamed)
tys
                                     ; t1' <- repLTy t1
                                     ; t2'  <- repLTy t2
                                     ; repTyArgs (repTInfix t1' tc t2') args }
            ; rhs1 <- repLTy rhs
            ; repTySynEqn mb_exp_bndrs tys1 rhs1 } }
     where checkTys :: [LHsTypeArg GhcRn] -> MetaM [LHsTypeArg GhcRn]
           checkTys :: HsFamEqnPats (GhcPass 'Renamed)
-> MetaM (HsFamEqnPats (GhcPass 'Renamed))
checkTys tys :: HsFamEqnPats (GhcPass 'Renamed)
tys@(HsValArg XValArg (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
_:HsValArg XValArg (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
_:HsFamEqnPats (GhcPass 'Renamed)
_) = [HsArg
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))]
-> ReaderT
     MetaWrappers
     DsM
     [HsArg
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return HsFamEqnPats (GhcPass 'Renamed)
[HsArg
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))]
tys
           checkTys HsFamEqnPats (GhcPass 'Renamed)
_ = String
-> ReaderT
     MetaWrappers
     DsM
     [HsArg
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))]
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))
-> HsFamEqnPats (GhcPass 'Renamed) -> MetaM (Core (M Type))
repTyArgs MetaM (Core (M Type))
f [] = MetaM (Core (M Type))
f
repTyArgs MetaM (Core (M Type))
f (HsValArg XValArg (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
ty : HsFamEqnPats (GhcPass 'Renamed)
as)  = do { f' <- MetaM (Core (M Type))
f
                                       ; ty' <- repLTy ty
                                       ; repTyArgs (repTapp f' ty') as }
repTyArgs MetaM (Core (M Type))
f (HsTypeArg XTypeArg (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
ki : HsFamEqnPats (GhcPass 'Renamed)
as) = do { f' <- MetaM (Core (M Type))
f
                                       ; ki' <- repLTy ki
                                       ; repTyArgs (repTappKind f' ki') as }
repTyArgs MetaM (Core (M Type))
f (HsArgPar XArgPar (GhcPass 'Renamed)
_ : HsFamEqnPats (GhcPass 'Renamed)
as) = MetaM (Core (M Type))
-> HsFamEqnPats (GhcPass 'Renamed) -> MetaM (Core (M Type))
repTyArgs MetaM (Core (M Type))
f HsFamEqnPats (GhcPass 'Renamed)
as

repDataFamInstD :: DataFamInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repDataFamInstD :: DataFamInstDecl (GhcPass 'Renamed) -> 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 (GhcPass 'Renamed)
tc_name
                                             , feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_bndrs = HsOuterFamEqnTyVarBndrs (GhcPass 'Renamed)
outer_bndrs
                                             , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_pats  = HsFamEqnPats (GhcPass 'Renamed)
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 (GhcPass 'Renamed)
defn }})
  = do { tc <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
tc_name         -- See Note [Binders and occurrences]
       ; addHsOuterFamEqnTyVarBinds outer_bndrs $ \Core (Maybe [M (TyVarBndr ())])
mb_exp_bndrs ->
         do { tys1 <- case LexicalFixity
fixity of
                        LexicalFixity
Prefix -> MetaM (Core (M Type))
-> HsFamEqnPats (GhcPass 'Renamed) -> MetaM (Core (M Type))
repTyArgs (Core Name -> MetaM (Core (M Type))
repNamedTyCon Core Name
tc) HsFamEqnPats (GhcPass 'Renamed)
tys
                        LexicalFixity
Infix  -> do { (HsValArg _ t1: HsValArg _ t2: args) <- HsFamEqnPats (GhcPass 'Renamed)
-> MetaM (HsFamEqnPats (GhcPass 'Renamed))
checkTys HsFamEqnPats (GhcPass 'Renamed)
tys
                                     ; t1' <- repLTy t1
                                     ; t2'  <- repLTy t2
                                     ; repTyArgs (repTInfix t1' tc t2') args }
            ; repDataDefn tc (Right (mb_exp_bndrs, tys1)) defn } }

      where checkTys :: [LHsTypeArg GhcRn] -> MetaM [LHsTypeArg GhcRn]
            checkTys :: HsFamEqnPats (GhcPass 'Renamed)
-> MetaM (HsFamEqnPats (GhcPass 'Renamed))
checkTys tys :: HsFamEqnPats (GhcPass 'Renamed)
tys@(HsValArg XValArg (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
_: HsValArg XValArg (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
_: HsFamEqnPats (GhcPass 'Renamed)
_) = [HsArg
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))]
-> ReaderT
     MetaWrappers
     DsM
     [HsArg
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))]
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return HsFamEqnPats (GhcPass 'Renamed)
[HsArg
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))]
tys
            checkTys HsFamEqnPats (GhcPass 'Renamed)
_ = String
-> ReaderT
     MetaWrappers
     DsM
     [HsArg
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))]
forall a. HasCallStack => String -> a
panic String
"repDataFamInstD:checkTys"

repForD :: LForeignDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repForD :: LForeignDecl (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repForD (L SrcSpanAnnA
loc (ForeignImport { fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name = LIdP (GhcPass 'Renamed)
name, fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty = LHsSigType (GhcPass 'Renamed)
typ
                                  , fd_fi :: forall pass. ForeignDecl pass -> ForeignImport pass
fd_fi = CImport XCImport (GhcPass 'Renamed)
_ (L EpaLocation
_ CCallConv
cc)
                                                    (L EpaLocation
_ Safety
s) Maybe Header
mch CImportSpec
cis }))
 = do MkC name' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
name
      MkC typ' <- repHsSigType typ
      MkC cc' <- repCCallConv cc
      MkC s' <- repSafety s
      cis' <- conv_cimportspec cis
      MkC str <- coreStringLit (mkFastString (static ++ chStr ++ cis'))
      dec <- rep2 forImpDName [cc', s', str, name', typ']
      return (locA loc, 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"
    -- these calling conventions do not support headers and the static keyword
    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 (GhcPass 'Renamed)
decl@(L SrcSpanAnnA
_ ForeignExport{}) = ThRejectionReason
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. ThRejectionReason -> MetaM a
notHandled (LForeignDecl (GhcPass 'Renamed) -> ThRejectionReason
ThForeignExport LForeignDecl (GhcPass 'Renamed)
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 (GhcPass 'Renamed) -> MetaM [(SrcSpan, Core (M Dec))]
repLFixD (L SrcSpanAnnA
loc FixitySig (GhcPass 'Renamed)
fix_sig) = SrcSpan
-> FixitySig (GhcPass 'Renamed) -> MetaM [(SrcSpan, Core (M Dec))]
rep_fix_d (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) FixitySig (GhcPass 'Renamed)
fix_sig

rep_fix_d :: SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_fix_d :: SrcSpan
-> FixitySig (GhcPass 'Renamed) -> MetaM [(SrcSpan, Core (M Dec))]
rep_fix_d SrcSpan
loc (FixitySig XFixitySig (GhcPass 'Renamed)
ns_spec [LIdP (GhcPass 'Renamed)]
names (Fixity Int
prec FixityDirection
dir))
  = do { MkC prec' <- Int -> MetaM (Core Int)
coreIntLit Int
prec
       ; let rep_fn = case FixityDirection
dir of
                        FixityDirection
InfixL -> Name
infixLWithSpecDName
                        FixityDirection
InfixR -> Name
infixRWithSpecDName
                        FixityDirection
InfixN -> Name
infixNWithSpecDName
       ; let do_one GenLocated SrcSpanAnnN Name
name
              = do { MkC name' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
name
                   ; MkC ns_spec' <- repNamespaceSpecifier ns_spec
                   ; dec <- rep2 rep_fn [prec', ns_spec', name']
                   ; return (loc,dec) }
       ; mapM do_one names }

repDefD :: LDefaultDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repDefD :: LDefaultDecl (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repDefD (L SrcSpanAnnA
loc (DefaultDecl XCDefaultDecl (GhcPass 'Renamed)
_ Maybe (LIdP (GhcPass 'Renamed))
_ [LHsType (GhcPass 'Renamed)]
tys)) = do { tys1 <- [LHsType (GhcPass 'Renamed)] -> MetaM [Core (M Type)]
repLTys [LHsType (GhcPass 'Renamed)]
tys
                                           ; MkC tys2 <- coreListM typeTyConName tys1
                                           ; dec <- rep2 defaultDName [tys2]
                                           ; return (locA loc, dec)}

repRuleD :: LRuleDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repRuleD :: LRuleDecl (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRuleD (L SrcSpanAnnA
loc (HsRule { rd_name :: forall pass. RuleDecl pass -> XRec pass FastString
rd_name = XRec (GhcPass 'Renamed) FastString
n
                        , rd_act :: forall pass. RuleDecl pass -> Activation
rd_act = Activation
act
                        , rd_bndrs :: forall pass. RuleDecl pass -> RuleBndrs pass
rd_bndrs = RuleBndrs (GhcPass 'Renamed)
bndrs
                        , rd_lhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_lhs = LHsExpr (GhcPass 'Renamed)
lhs
                        , rd_rhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_rhs = LHsExpr (GhcPass 'Renamed)
rhs }))
  = (Core (M Dec) -> (SrcSpan, Core (M Dec)))
-> MetaM (Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a b.
(a -> b)
-> ReaderT MetaWrappers DsM a -> ReaderT MetaWrappers DsM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc, ) (MetaM (Core (M Dec))
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> ((Core (Maybe [M (TyVarBndr ())])
     -> Core [M RuleBndr] -> MetaM (Core (M Dec)))
    -> MetaM (Core (M Dec)))
-> (Core (Maybe [M (TyVarBndr ())])
    -> Core [M RuleBndr] -> MetaM (Core (M Dec)))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      RuleBndrs (GhcPass 'Renamed)
-> (Core (Maybe [M (TyVarBndr ())])
    -> Core [M RuleBndr] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall {k} (a :: k).
RuleBndrs (GhcPass 'Renamed)
-> (Core (Maybe [M (TyVarBndr ())])
    -> Core [M RuleBndr] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repRuleBinders RuleBndrs (GhcPass 'Renamed)
bndrs ((Core (Maybe [M (TyVarBndr ())])
  -> Core [M RuleBndr] -> MetaM (Core (M Dec)))
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> (Core (Maybe [M (TyVarBndr ())])
    -> Core [M RuleBndr] -> MetaM (Core (M Dec)))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \ Core (Maybe [M (TyVarBndr ())])
ty_bndrs' Core [M RuleBndr]
tm_bndrs' ->
        do { 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 EpAnnCO FastString -> FastString
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass 'Renamed) FastString
GenLocated EpAnnCO FastString
n
           ; act' <- repPhases act
           ; lhs' <- repLE lhs
           ; rhs' <- repLE rhs
           ; repPragRule n' ty_bndrs' tm_bndrs' lhs' rhs' act' }

repRuleBinders :: RuleBndrs GhcRn
               -> (Core (Maybe [M (TH.TyVarBndr ())]) -> Core [M TH.RuleBndr] -> MetaM (Core (M a)))
               -> MetaM (Core (M a))
repRuleBinders :: forall {k} (a :: k).
RuleBndrs (GhcPass 'Renamed)
-> (Core (Maybe [M (TyVarBndr ())])
    -> Core [M RuleBndr] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repRuleBinders (RuleBndrs { rb_tyvs :: forall pass.
RuleBndrs pass -> Maybe [LHsTyVarBndr () (NoGhcTc pass)]
rb_tyvs = Maybe [LHsTyVarBndr () (NoGhcTc (GhcPass 'Renamed))]
m_ty_bndrs, rb_tmvs :: forall pass. RuleBndrs pass -> [LRuleBndr (NoGhcTc pass)]
rb_tmvs = [LRuleBndr (NoGhcTc (GhcPass 'Renamed))]
tm_bndrs }) Core (Maybe [M (TyVarBndr ())])
-> Core [M RuleBndr] -> MetaM (Core (M a))
thing_inside
  = do { let ty_bndrs :: [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Renamed))]
ty_bndrs = [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Renamed))]
-> Maybe
     [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Renamed))]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Renamed))]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LHsTyVarBndr () (NoGhcTc (GhcPass 'Renamed))]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Renamed))]
m_ty_bndrs
       ; FreshOrReuse
-> [LHsTyVarBndr () (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr () (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Renamed))]
ty_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 ())]
ex_bndrs ->
          do { let tm_bndr_names :: [Name]
tm_bndr_names = (GenLocated EpAnnCO (RuleBndr (GhcPass 'Renamed)) -> [Name])
-> [GenLocated EpAnnCO (RuleBndr (GhcPass 'Renamed))] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LRuleBndr (GhcPass 'Renamed) -> [Name]
GenLocated EpAnnCO (RuleBndr (GhcPass 'Renamed)) -> [Name]
ruleBndrNames [LRuleBndr (NoGhcTc (GhcPass 'Renamed))]
[GenLocated EpAnnCO (RuleBndr (GhcPass 'Renamed))]
tm_bndrs
             ; ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
tm_bndr_names
             ; x <- addBinds ss $
                 do { elt_ty <- wrapName tyVarBndrUnitTyConName
                    ; ty_bndrs' <- return $ case m_ty_bndrs of
                        Maybe [LHsTyVarBndr () (NoGhcTc (GhcPass 'Renamed))]
Nothing -> Type -> Core (Maybe [M (TyVarBndr ())])
forall a. Type -> Core (Maybe a)
coreNothing' (Type -> Type
mkListTy Type
elt_ty)
                        Just [LHsTyVarBndr () (NoGhcTc (GhcPass 'Renamed))]
_  -> 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
                    ; tm_bndrs' <- repListM ruleBndrTyConName
                                           repRuleBndr
                                           tm_bndrs
                    ; thing_inside ty_bndrs' tm_bndrs'
                    }
              ; wrapGenSyms ss x }
        }

ruleBndrNames :: LRuleBndr GhcRn -> [Name]
ruleBndrNames :: LRuleBndr (GhcPass 'Renamed) -> [Name]
ruleBndrNames (L EpAnnCO
_ (RuleBndr XCRuleBndr (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
n))      = [GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
n]
ruleBndrNames (L EpAnnCO
_ (RuleBndrSig XRuleBndrSig (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
n HsPatSigType (GhcPass 'Renamed)
sig))
  | HsPS { hsps_ext :: forall pass. HsPatSigType pass -> XHsPS pass
hsps_ext = HsPSRn { hsps_imp_tvs :: HsPSRn -> [Name]
hsps_imp_tvs = [Name]
vars }} <- HsPatSigType (GhcPass 'Renamed)
sig
  = GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
vars

repRuleBndr :: LRuleBndr GhcRn -> MetaM (Core (M TH.RuleBndr))
repRuleBndr :: LRuleBndr (GhcPass 'Renamed) -> MetaM (Core (M RuleBndr))
repRuleBndr (L EpAnnCO
_ (RuleBndr XCRuleBndr (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
n))
  = do { MkC n' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
n
       ; rep2 ruleVarName [n'] }
repRuleBndr (L EpAnnCO
_ (RuleBndrSig XRuleBndrSig (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
n HsPatSigType (GhcPass 'Renamed)
sig))
  = do { MkC n'  <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
n
       ; MkC ty' <- repLTy (hsPatSigType sig)
       ; rep2 typedRuleVarName [n', ty'] }

repAnnD :: LAnnDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repAnnD :: LAnnDecl (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repAnnD (L SrcSpanAnnA
loc (HsAnnotation XHsAnnotation (GhcPass 'Renamed)
_ AnnProvenance (GhcPass 'Renamed)
ann_prov (L SrcSpanAnnA
_ HsExpr (GhcPass 'Renamed)
exp)))
  = do { target <- AnnProvenance (GhcPass 'Renamed) -> MetaM (Core AnnTarget)
repAnnProv AnnProvenance (GhcPass 'Renamed)
ann_prov
       ; exp'   <- repE exp
       ; dec    <- repPragAnn target exp'
       ; return (locA loc, dec) }

repAnnProv :: AnnProvenance GhcRn -> MetaM (Core TH.AnnTarget)
repAnnProv :: AnnProvenance (GhcPass 'Renamed) -> MetaM (Core AnnTarget)
repAnnProv (ValueAnnProvenance LIdP (GhcPass 'Renamed)
n)
  = do { -- An ANN references an identifier bound elsewhere in the module, so
         -- we must look it up using lookupLOcc (#19377).
         -- Similarly for TypeAnnProvenance (`ANN type`) below.
         MkC n' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
n
       ; rep2_nw valueAnnotationName [ n' ] }
repAnnProv (TypeAnnProvenance LIdP (GhcPass 'Renamed)
n)
  = do { MkC n' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
n
       ; rep2_nw typeAnnotationName [ n' ] }
repAnnProv AnnProvenance (GhcPass 'Renamed)
ModuleAnnProvenance
  = Name -> [CoreExpr] -> MetaM (Core AnnTarget)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
moduleAnnotationName []

-------------------------------------------------------
--                      Constructors
-------------------------------------------------------

repC :: LConDecl GhcRn -> MetaM (Core (M TH.Con))
repC :: LConDecl (GhcPass 'Renamed) -> MetaM (Core (M Con))
repC (L SrcSpanAnnA
_ (ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name   = LIdP (GhcPass 'Renamed)
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 (GhcPass 'Renamed))
Nothing
                      , con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args   = HsConDeclH98Details (GhcPass 'Renamed)
args }))
  = GenLocated SrcSpanAnnN Name
-> HsConDeclH98Details (GhcPass 'Renamed) -> MetaM (Core (M Con))
repH98DataCon LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
con HsConDeclH98Details (GhcPass 'Renamed)
args

repC (L SrcSpanAnnA
_ (ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = LIdP (GhcPass 'Renamed)
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 (GhcPass 'Renamed)]
con_tvs
                      , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext (GhcPass 'Renamed))
mcxt
                      , con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details (GhcPass 'Renamed)
args }))
  = FreshOrReuse
-> [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con))
forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
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 { c'    <- GenLocated SrcSpanAnnN Name
-> HsConDeclH98Details (GhcPass 'Renamed) -> MetaM (Core (M Con))
repH98DataCon LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
con HsConDeclH98Details (GhcPass 'Renamed)
args
            ; ctxt' <- repMbContext mcxt
            ; if not is_existential && isNothing mcxt
              then return c'
              else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c'])
            }

repC (L SrcSpanAnnA
_ (ConDeclGADT { con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names  = NonEmpty (LIdP (GhcPass 'Renamed))
cons
                       , con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_bndrs  = L SrcSpanAnnA
_ HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs
                       , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext (GhcPass 'Renamed))
mcxt
                       , con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails (GhcPass 'Renamed)
args
                       , con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty = LHsType (GhcPass 'Renamed)
res_ty }))
  | Bool
null_outer_imp_tvs Bool -> Bool -> Bool
&& Bool
null_outer_exp_tvs
                                 -- No implicit or explicit variables
  , Maybe (LHsContext (GhcPass 'Renamed))
Nothing <- Maybe (LHsContext (GhcPass 'Renamed))
mcxt              -- No context
                                 -- ==> no need for a forall
  = NonEmpty (GenLocated SrcSpanAnnN Name)
-> HsConDeclGADTDetails (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> MetaM (Core (M Con))
repGadtDataCons NonEmpty (LIdP (GhcPass 'Renamed))
NonEmpty (GenLocated SrcSpanAnnN Name)
cons HsConDeclGADTDetails (GhcPass 'Renamed)
args LHsType (GhcPass 'Renamed)
res_ty

  | Bool
otherwise
  = HsOuterSigTyVarBndrs (GhcPass 'Renamed)
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con))
forall {k} (a :: k).
HsOuterSigTyVarBndrs (GhcPass 'Renamed)
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterSigTyVarBinds HsOuterSigTyVarBndrs (GhcPass 'Renamed)
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' ->
             -- See Note [Don't quantify implicit type variables in quotes]
    do { c'    <- NonEmpty (GenLocated SrcSpanAnnN Name)
-> HsConDeclGADTDetails (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> MetaM (Core (M Con))
repGadtDataCons NonEmpty (LIdP (GhcPass 'Renamed))
NonEmpty (GenLocated SrcSpanAnnN Name)
cons HsConDeclGADTDetails (GhcPass 'Renamed)
args LHsType (GhcPass 'Renamed)
res_ty
       ; ctxt' <- repMbContext mcxt
       ; if null_outer_exp_tvs && isNothing mcxt
         then return c'
         else rep2 forallCName ([unC outer_bndrs', unC ctxt', unC c']) }
  where
    null_outer_imp_tvs :: Bool
null_outer_imp_tvs = HsOuterSigTyVarBndrs (GhcPass 'Renamed) -> Bool
nullOuterImplicit HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs
    null_outer_exp_tvs :: Bool
null_outer_exp_tvs = HsOuterSigTyVarBndrs (GhcPass 'Renamed) -> Bool
nullOuterExplicit HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs

repMbContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M TH.Cxt))
repMbContext :: Maybe (LHsContext (GhcPass 'Renamed)) -> MetaM (Core (M Cxt))
repMbContext Maybe (LHsContext (GhcPass 'Renamed))
Nothing          = [LHsType (GhcPass 'Renamed)] -> MetaM (Core (M Cxt))
repContext []
repMbContext (Just (L SrcSpanAnnC
_ [GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))]
cxt)) = [LHsType (GhcPass 'Renamed)] -> MetaM (Core (M Cxt))
repContext [LHsType (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))]
cxt

repSrcUnpackedness :: SrcUnpackedness -> MetaM (Core (M TH.SourceUnpackedness))
repSrcUnpackedness :: SrcUnpackedness -> MetaM (Core (M SourceUnpackedness))
repSrcUnpackedness SrcUnpackedness
SrcUnpack   = Name -> [CoreExpr] -> MetaM (Core (M SourceUnpackedness))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceUnpackName         []
repSrcUnpackedness SrcUnpackedness
SrcNoUnpack = Name -> [CoreExpr] -> MetaM (Core (M SourceUnpackedness))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceNoUnpackName       []
repSrcUnpackedness SrcUnpackedness
NoSrcUnpack = Name -> [CoreExpr] -> MetaM (Core (M SourceUnpackedness))
forall {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceLazyName         []
repSrcStrictness SrcStrictness
SrcStrict   = Name -> [CoreExpr] -> MetaM (Core (M SourceStrictness))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceStrictName       []
repSrcStrictness SrcStrictness
NoSrcStrict = Name -> [CoreExpr] -> MetaM (Core (M SourceStrictness))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
noSourceStrictnessName []

repConDeclField :: HsConDeclField GhcRn -> MetaM (Core (M TH.BangType))
repConDeclField :: HsConDeclField (GhcPass 'Renamed) -> MetaM (Core (M BangType))
repConDeclField (CDF { SrcUnpackedness
cdf_unpack :: SrcUnpackedness
cdf_unpack :: forall pass. HsConDeclField pass -> SrcUnpackedness
cdf_unpack, SrcStrictness
cdf_bang :: SrcStrictness
cdf_bang :: forall pass. HsConDeclField pass -> SrcStrictness
cdf_bang, LHsType (GhcPass 'Renamed)
cdf_type :: LHsType (GhcPass 'Renamed)
cdf_type :: forall pass. HsConDeclField pass -> LHsType pass
cdf_type }) = do
  MkC u <- SrcUnpackedness -> MetaM (Core (M SourceUnpackedness))
repSrcUnpackedness SrcUnpackedness
cdf_unpack
  MkC s <- repSrcStrictness cdf_bang
  MkC b <- rep2 bangName [u, s]
  MkC t <- repLTy cdf_type
  rep2 bangTypeName [b, t]

-------------------------------------------------------
--                      Deriving clauses
-------------------------------------------------------

repDerivs :: HsDeriving GhcRn -> MetaM (Core [M TH.DerivClause])
repDerivs :: HsDeriving (GhcPass 'Renamed) -> MetaM (Core [M DerivClause])
repDerivs HsDeriving (GhcPass 'Renamed)
clauses
  = Name
-> (GenLocated EpAnnCO (HsDerivingClause (GhcPass 'Renamed))
    -> MetaM (Core (M DerivClause)))
-> [GenLocated EpAnnCO (HsDerivingClause (GhcPass 'Renamed))]
-> MetaM (Core [M DerivClause])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
derivClauseTyConName LHsDerivingClause (GhcPass 'Renamed)
-> MetaM (Core (M DerivClause))
GenLocated EpAnnCO (HsDerivingClause (GhcPass 'Renamed))
-> MetaM (Core (M DerivClause))
repDerivClause HsDeriving (GhcPass 'Renamed)
[GenLocated EpAnnCO (HsDerivingClause (GhcPass 'Renamed))]
clauses

repDerivClause :: LHsDerivingClause GhcRn
               -> MetaM (Core (M TH.DerivClause))
repDerivClause :: LHsDerivingClause (GhcPass 'Renamed)
-> MetaM (Core (M DerivClause))
repDerivClause (L EpAnnCO
_ (HsDerivingClause
                          { deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy = Maybe (LDerivStrategy (GhcPass 'Renamed))
dcs
                          , deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_tys      = LDerivClauseTys (GhcPass 'Renamed)
dct }))
  = Maybe (LDerivStrategy (GhcPass 'Renamed))
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M DerivClause)))
-> MetaM (Core (M DerivClause))
forall {k} (a :: k).
Maybe (LDerivStrategy (GhcPass 'Renamed))
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy Maybe (LDerivStrategy (GhcPass 'Renamed))
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 dct' <- LDerivClauseTys (GhcPass 'Renamed) -> MetaM (Core [M Type])
rep_deriv_clause_tys LDerivClauseTys (GhcPass 'Renamed)
dct
       rep2 derivClauseName [dcs',dct']
  where
    rep_deriv_clause_tys :: LDerivClauseTys GhcRn -> MetaM (Core [M TH.Type])
    rep_deriv_clause_tys :: LDerivClauseTys (GhcPass 'Renamed) -> MetaM (Core [M Type])
rep_deriv_clause_tys (L SrcSpanAnnC
_ DerivClauseTys (GhcPass 'Renamed)
dct) = case DerivClauseTys (GhcPass 'Renamed)
dct of
      DctSingle XDctSingle (GhcPass 'Renamed)
_ LHsSigType (GhcPass 'Renamed)
ty -> [LHsSigType (GhcPass 'Renamed)] -> MetaM (Core [M Type])
rep_deriv_tys [LHsSigType (GhcPass 'Renamed)
ty]
      DctMulti XDctMulti (GhcPass 'Renamed)
_ [LHsSigType (GhcPass 'Renamed)]
tys -> [LHsSigType (GhcPass 'Renamed)] -> MetaM (Core [M Type])
rep_deriv_tys [LHsSigType (GhcPass 'Renamed)]
tys

    rep_deriv_tys :: [LHsSigType GhcRn] -> MetaM (Core [M TH.Type])
    rep_deriv_tys :: [LHsSigType (GhcPass 'Renamed)] -> MetaM (Core [M Type])
rep_deriv_tys = Name
-> (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
    -> MetaM (Core (M Type)))
-> [GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))]
-> MetaM (Core [M Type])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
typeTyConName LHsSigType (GhcPass 'Renamed) -> MetaM (Core (M Type))
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
-> MetaM (Core (M Type))
repHsSigType

rep_meth_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn
                    -> MetaM ([GenSymBind], [Core (M TH.Dec)])
-- Represent signatures and methods in class/instance declarations.
-- See Note [Scoped type variables in quotes]
--
-- Why not use 'repBinds': we have already created symbols for methods in
-- 'repTopDs' via 'hsGroupBinders'. However in 'repBinds', we recreate
-- these fun_id via 'collectHsValBinders decs', which would lead to the
-- instance declarations failing in TH.
rep_meth_sigs_binds :: [LSig (GhcPass 'Renamed)]
-> LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> MetaM ([GenSymBind], [Core (M Dec)])
rep_meth_sigs_binds [LSig (GhcPass 'Renamed)]
sigs LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
binds
  = do { let tvs :: [Name]
tvs = (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> [Name])
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LSig (GhcPass 'Renamed) -> [Name]
GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> [Name]
get_scoped_tvs [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
sigs
       ; ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
tvs
       ; sigs1 <- addBinds ss $ rep_sigs sigs
       ; binds1 <- addBinds ss $ rep_binds binds
       ; return (ss, de_loc (sort_by_loc (sigs1 ++ binds1))) }

-------------------------------------------------------
--   Signatures in a class decl, or a group of bindings
-------------------------------------------------------

rep_sigs :: [LSig GhcRn] -> MetaM [(SrcSpan, Core (M TH.Dec))]
        -- We silently ignore ones we don't recognise
rep_sigs :: [LSig (GhcPass 'Renamed)] -> MetaM [(SrcSpan, Core (M Dec))]
rep_sigs = (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))
 -> MetaM [(SrcSpan, Core (M Dec))])
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM LSig (GhcPass 'Renamed) -> MetaM [(SrcSpan, Core (M Dec))]
GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))
-> MetaM [(SrcSpan, Core (M Dec))]
rep_sig

rep_sig :: LSig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_sig :: LSig (GhcPass 'Renamed) -> MetaM [(SrcSpan, Core (M Dec))]
rep_sig (L SrcSpanAnnA
loc (TypeSig XTypeSig (GhcPass 'Renamed)
_ [LIdP (GhcPass 'Renamed)]
nms LHsSigWcType (GhcPass 'Renamed)
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 (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_wc_ty_sig Name
sigDName (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) LHsSigWcType (GhcPass 'Renamed)
ty) [LIdP (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
nms
rep_sig (L SrcSpanAnnA
loc (PatSynSig XPatSynSig (GhcPass 'Renamed)
_ [LIdP (GhcPass 'Renamed)]
nms LHsSigType (GhcPass 'Renamed)
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 (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_patsyn_ty_sig (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) LHsSigType (GhcPass 'Renamed)
ty) [LIdP (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
nms
rep_sig (L SrcSpanAnnA
loc (ClassOpSig XClassOpSig (GhcPass 'Renamed)
_ Bool
is_deflt [LIdP (GhcPass 'Renamed)]
nms LHsSigType (GhcPass 'Renamed)
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 (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
defaultSigDName (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) LHsSigType (GhcPass 'Renamed)
ty) [LIdP (GhcPass 'Renamed)]
[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 (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
sigDName (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) LHsSigType (GhcPass 'Renamed)
ty) [LIdP (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
nms
rep_sig (L SrcSpanAnnA
loc (FixSig XFixSig (GhcPass 'Renamed)
_ FixitySig (GhcPass 'Renamed)
fix_sig))   = SrcSpan
-> FixitySig (GhcPass 'Renamed) -> MetaM [(SrcSpan, Core (M Dec))]
rep_fix_d (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) FixitySig (GhcPass 'Renamed)
fix_sig
rep_sig (L SrcSpanAnnA
loc (InlineSig XInlineSig (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
nm InlinePragma
ispec))= GenLocated SrcSpanAnnN Name
-> InlinePragma -> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_inline LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
nm InlinePragma
ispec (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc)
rep_sig (L SrcSpanAnnA
loc (SpecSig XSpecSig (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
nm [LHsSigType (GhcPass 'Renamed)]
tys InlinePragma
ispec))
  = (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
 -> MetaM [(SrcSpan, Core (M Dec))])
-> [GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))]
-> 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 (GhcPass 'Renamed))
t -> GenLocated SrcSpanAnnN Name
-> LHsSigType (GhcPass 'Renamed)
-> InlinePragma
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_specialise LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
nm LHsSigType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
t InlinePragma
ispec (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc)) [LHsSigType (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))]
tys
rep_sig (L SrcSpanAnnA
loc (SpecSigE XSpecSigE (GhcPass 'Renamed)
_nm RuleBndrs (GhcPass 'Renamed)
bndrs LHsExpr (GhcPass 'Renamed)
expr InlinePragma
ispec))
  = (Core (M Dec) -> [(SrcSpan, Core (M Dec))])
-> MetaM (Core (M Dec)) -> MetaM [(SrcSpan, Core (M Dec))]
forall a b.
(a -> b)
-> ReaderT MetaWrappers DsM a -> ReaderT MetaWrappers DsM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Core (M Dec)
d -> [(SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc, Core (M Dec)
d)]) (MetaM (Core (M Dec)) -> MetaM [(SrcSpan, Core (M Dec))])
-> MetaM (Core (M Dec)) -> MetaM [(SrcSpan, Core (M Dec))]
forall a b. (a -> b) -> a -> b
$
    RuleBndrs (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed)
-> InlinePragma
-> MetaM (Core (M Dec))
rep_specialiseE RuleBndrs (GhcPass 'Renamed)
bndrs LHsExpr (GhcPass 'Renamed)
expr InlinePragma
ispec
rep_sig (L SrcSpanAnnA
loc (SpecInstSig XSpecInstSig (GhcPass 'Renamed)
_ LHsSigType (GhcPass 'Renamed)
ty))   = LHsSigType (GhcPass 'Renamed)
-> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_specialiseInst LHsSigType (GhcPass 'Renamed)
ty (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => 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
loc (SCCFunSig XSCCFunSig (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
nm Maybe (XRec (GhcPass 'Renamed) StringLiteral)
str)) = GenLocated SrcSpanAnnN Name
-> Maybe (XRec (GhcPass 'Renamed) StringLiteral)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_sccFun LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
nm Maybe (XRec (GhcPass 'Renamed) StringLiteral)
str (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc)
rep_sig (L SrcSpanAnnA
loc (CompleteMatchSig XCompleteMatchSig (GhcPass 'Renamed)
_ [LIdP (GhcPass 'Renamed)]
cls Maybe (LIdP (GhcPass 'Renamed))
mty))
  = [GenLocated SrcSpanAnnN Name]
-> Maybe (GenLocated SrcSpanAnnN Name)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_complete_sig [LIdP (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
cls Maybe (LIdP (GhcPass 'Renamed))
Maybe (GenLocated SrcSpanAnnN Name)
mty (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc)
rep_sig d :: LSig (GhcPass 'Renamed)
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 (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LSig (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))
d)

-- Desugar the explicit type variable binders in an 'LHsSigType', making
-- sure not to gensym them.
-- See Note [Scoped type variables in quotes]
-- and Note [Don't quantify implicit type variables in quotes]
rep_ty_sig_tvs :: [LHsTyVarBndr Specificity GhcRn]
               -> MetaM (Core [M (TH.TyVarBndr TH.Specificity)])
rep_ty_sig_tvs :: [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
explicit_tvs
  = Name
-> (GenLocated
      SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Renamed))
    -> MetaM (Core (M (TyVarBndr Specificity))))
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Renamed))]
-> MetaM (Core [M (TyVarBndr Specificity)])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
tyVarBndrSpecTyConName LHsTyVarBndr Specificity (GhcPass 'Renamed)
-> MetaM (Core (M (TyVarBndr Specificity)))
GenLocated SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Renamed))
-> MetaM (Core (M (TyVarBndr Specificity)))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag (GhcPass 'Renamed)
-> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr
             [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Renamed))]
explicit_tvs

-- Desugar the outer type variable binders in an 'LHsSigType', making
-- sure not to gensym them.
-- See Note [Scoped type variables in quotes]
-- and Note [Don't quantify implicit type variables in quotes]
rep_ty_sig_outer_tvs :: HsOuterSigTyVarBndrs GhcRn
                     -> MetaM (Core [M (TH.TyVarBndr TH.Specificity)])
rep_ty_sig_outer_tvs :: HsOuterSigTyVarBndrs (GhcPass 'Renamed)
-> 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 (GhcPass 'Renamed))]
explicit_tvs}) =
  [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity (NoGhcTc (GhcPass 'Renamed))]
[LHsTyVarBndr Specificity (GhcPass 'Renamed)]
explicit_tvs

-- Desugar a top-level type signature. Unlike 'repHsSigType', this
-- deliberately avoids gensymming the type variables.
-- See Note [Scoped type variables in quotes]
-- and Note [Don't quantify implicit type variables in quotes]
rep_ty_sig :: Name -> SrcSpan -> LHsSigType GhcRn -> LocatedN Name
           -> MetaM (SrcSpan, Core (M TH.Dec))
rep_ty_sig :: Name
-> SrcSpan
-> LHsSigType (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
mk_sig SrcSpan
loc LHsSigType (GhcPass 'Renamed)
sig_ty GenLocated SrcSpanAnnN Name
nm
  = do { nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
       ; ty1 <- rep_ty_sig' sig_ty
       ; sig <- repProto mk_sig nm1 ty1
       ; return (loc, sig) }

-- Desugar an 'LHsSigType', making sure not to gensym the type variables at
-- the front of the type signature.
-- See Note [Scoped type variables in quotes]
-- and Note [Don't quantify implicit type variables in quotes]
rep_ty_sig' :: LHsSigType GhcRn
            -> MetaM (Core (M TH.Type))
rep_ty_sig' :: LHsSigType (GhcPass 'Renamed) -> MetaM (Core (M Type))
rep_ty_sig' (L SrcSpanAnnA
_ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType (GhcPass 'Renamed)
body}))
  | (Maybe (LHsContext (GhcPass 'Renamed))
ctxt, LHsType (GhcPass 'Renamed)
tau) <- LHsType (GhcPass 'Renamed)
-> (Maybe (LHsContext (GhcPass 'Renamed)),
    LHsType (GhcPass 'Renamed))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy LHsType (GhcPass 'Renamed)
body
  = do { th_explicit_tvs <- HsOuterSigTyVarBndrs (GhcPass 'Renamed)
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_outer_tvs HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs
       ; th_ctxt <- repLContext ctxt
       ; th_tau  <- repLTy tau
       ; if nullOuterExplicit outer_bndrs && null (fromMaybeContext ctxt)
            then return th_tau
            else repTForall th_explicit_tvs th_ctxt th_tau }

rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> LocatedN Name
                  -> MetaM (SrcSpan, Core (M TH.Dec))
-- represents a pattern synonym type signature;
-- see Note [Pattern synonym type signatures and Template Haskell] in "GHC.ThToHs"
--
-- Don't create the implicit and explicit variables when desugaring signatures,
-- see Note [Scoped type variables in quotes]
-- and Note [Don't quantify implicit type variables in quotes]
rep_patsyn_ty_sig :: SrcSpan
-> LHsSigType (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_patsyn_ty_sig SrcSpan
loc LHsSigType (GhcPass 'Renamed)
sig_ty GenLocated SrcSpanAnnN Name
nm
  | ([LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass 'Renamed))]
univs, Maybe (LHsContext (GhcPass 'Renamed))
reqs, [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
exis, Maybe (LHsContext (GhcPass 'Renamed))
provs, LHsType (GhcPass 'Renamed)
ty) <- LHsSigType (GhcPass 'Renamed)
-> ([LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass 'Renamed))],
    Maybe (LHsContext (GhcPass 'Renamed)),
    [LHsTyVarBndr Specificity (GhcPass 'Renamed)],
    Maybe (LHsContext (GhcPass 'Renamed)), LHsType (GhcPass 'Renamed))
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 (GhcPass 'Renamed)
sig_ty
  = do { nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
       ; th_univs <- rep_ty_sig_tvs univs
       ; th_exis  <- rep_ty_sig_tvs exis

       ; th_reqs  <- repLContext reqs
       ; th_provs <- repLContext provs
       ; th_ty    <- repLTy ty
       ; ty1      <- repTForall th_univs th_reqs =<<
                       repTForall th_exis th_provs th_ty
       ; sig      <- repProto patSynSigDName nm1 ty1
       ; return (loc, sig) }

rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> LocatedN Name
              -> MetaM (SrcSpan, Core (M TH.Dec))
rep_wc_ty_sig :: Name
-> SrcSpan
-> LHsSigWcType (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_wc_ty_sig Name
mk_sig SrcSpan
loc LHsSigWcType (GhcPass 'Renamed)
sig_ty GenLocated SrcSpanAnnN Name
nm
  = Name
-> SrcSpan
-> LHsSigType (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
mk_sig SrcSpan
loc (HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsSigWcType (GhcPass 'Renamed)
HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
sig_ty) GenLocated SrcSpanAnnN Name
nm

rep_inline :: LocatedN Name
           -> InlinePragma      -- Never defaultInlinePragma
           -> 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 { nm1    <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
       ; opq <- repPragOpaque nm1
       ; return [(loc, opq)]
       }

rep_inline GenLocated SrcSpanAnnN Name
nm InlinePragma
ispec SrcSpan
loc
  = do { nm1    <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
       ; inline <- repInline $ inl_inline ispec
       ; rm     <- repRuleMatch $ inl_rule ispec
       ; phases <- repPhases $ inl_act ispec
       ; pragma <- repPragInl nm1 inline rm phases
       ; return [(loc, pragma)]
       }

rep_inline_phases :: InlinePragma -> MetaM (Maybe (Core TH.Inline), Core TH.Phases)
rep_inline_phases :: InlinePragma -> MetaM (Maybe (Core Inline), Core Phases)
rep_inline_phases (InlinePragma { inl_act :: InlinePragma -> Activation
inl_act = Activation
act, inl_inline :: InlinePragma -> InlineSpec
inl_inline = InlineSpec
inl })
  = do { phases <- Activation -> MetaM (Core Phases)
repPhases Activation
act
       ; inl <- if noUserInlineSpec inl
                -- SPECIALISE
                then return Nothing
                -- SPECIALISE INLINE
                else Just <$> repInline inl
       ; return (inl, phases) }

rep_specialise :: LocatedN Name -> LHsSigType GhcRn -> InlinePragma
               -> SrcSpan
               -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_specialise :: GenLocated SrcSpanAnnN Name
-> LHsSigType (GhcPass 'Renamed)
-> InlinePragma
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_specialise GenLocated SrcSpanAnnN Name
nm LHsSigType (GhcPass 'Renamed)
ty InlinePragma
ispec SrcSpan
loc
  -- Old form SPECIALISE pragmas
  = do { nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
       ; ty1 <- repHsSigType ty
       ; (inl, phases) <- rep_inline_phases ispec
       ; pragma <- repPragSpec nm1 ty1 inl phases
       ; return [(loc, pragma)]
       }

rep_specialiseE :: RuleBndrs GhcRn -> LHsExpr GhcRn -> InlinePragma
                -> MetaM (Core (M TH.Dec))
rep_specialiseE :: RuleBndrs (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed)
-> InlinePragma
-> MetaM (Core (M Dec))
rep_specialiseE RuleBndrs (GhcPass 'Renamed)
bndrs LHsExpr (GhcPass 'Renamed)
e InlinePragma
ispec
  -- New form SPECIALISE pragmas
  = RuleBndrs (GhcPass 'Renamed)
-> (Core (Maybe [M (TyVarBndr ())])
    -> Core [M RuleBndr] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall {k} (a :: k).
RuleBndrs (GhcPass 'Renamed)
-> (Core (Maybe [M (TyVarBndr ())])
    -> Core [M RuleBndr] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repRuleBinders RuleBndrs (GhcPass 'Renamed)
bndrs ((Core (Maybe [M (TyVarBndr ())])
  -> Core [M RuleBndr] -> MetaM (Core (M Dec)))
 -> MetaM (Core (M Dec)))
-> (Core (Maybe [M (TyVarBndr ())])
    -> Core [M RuleBndr] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \ Core (Maybe [M (TyVarBndr ())])
ty_bndrs Core [M RuleBndr]
tm_bndrs ->
      do { (inl, phases) <- InlinePragma -> MetaM (Maybe (Core Inline), Core Phases)
rep_inline_phases InlinePragma
ispec
         ; exp <- repLE e
         ; repPragSpecE ty_bndrs tm_bndrs exp inl phases
         }

rep_specialiseInst :: LHsSigType GhcRn -> SrcSpan
                   -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_specialiseInst :: LHsSigType (GhcPass 'Renamed)
-> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_specialiseInst LHsSigType (GhcPass 'Renamed)
ty SrcSpan
loc
  = do { ty1    <- LHsSigType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repHsSigType LHsSigType (GhcPass 'Renamed)
ty
       ; pragma <- repPragSpecInst ty1
       ; return [(loc, pragma)] }

rep_sccFun :: LocatedN Name
        -> Maybe (XRec GhcRn StringLiteral)
        -> SrcSpan
        -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_sccFun :: GenLocated SrcSpanAnnN Name
-> Maybe (XRec (GhcPass 'Renamed) StringLiteral)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_sccFun GenLocated SrcSpanAnnN Name
nm Maybe (XRec (GhcPass 'Renamed) StringLiteral)
Nothing SrcSpan
loc = do
  nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
  scc <- repPragSCCFun nm1
  return [(loc, scc)]

rep_sccFun GenLocated SrcSpanAnnN Name
nm (Just (L EpAnnCO
_ StringLiteral
str)) SrcSpan
loc = do
  nm1 <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
nm
  str1 <- coreStringLit (sl_fs str)
  scc <- repPragSCCFunNamed nm1 str1
  return [(loc, scc)]

repInline :: InlineSpec -> MetaM (Core TH.Inline)
repInline :: InlineSpec -> MetaM (Core Inline)
repInline (NoInline          SourceText
_ )   = Name -> MetaM (Core Inline)
forall {k} (a :: k). Name -> MetaM (Core a)
dataCon Name
noInlineDataConName
-- There is a mismatch between the TH and GHC representation because
-- OPAQUE pragmas can't have phase activation annotations (which is
-- enforced by the TH API), therefore they are desugared to OpaqueP rather than
-- InlineP, see special case in rep_inline.
repInline (Opaque            SourceText
_ )   = String -> MetaM (Core Inline)
forall a. HasCallStack => String -> a
panic String
"repInline: Opaque"
repInline (Inline            SourceText
_ )   = Name -> MetaM (Core Inline)
forall {k} (a :: k). Name -> MetaM (Core a)
dataCon Name
inlineDataConName
repInline (Inlinable         SourceText
_ )   = Name -> MetaM (Core Inline)
forall {k} (a :: k). 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 {k} (a :: k). Name -> MetaM (Core a)
dataCon Name
conLikeDataConName
repRuleMatch RuleMatchInfo
FunLike = Name -> MetaM (Core RuleMatch)
forall {k} (a :: k). 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 arg <- Int -> MetaM (Core Int)
coreIntLit Int
i
                                  ; dataCon' beforePhaseDataConName [arg] }
repPhases (ActiveAfter SourceText
_ Int
i)  = do { MkC arg <- Int -> MetaM (Core Int)
coreIntLit Int
i
                                  ; dataCon' fromPhaseDataConName [arg] }
repPhases Activation
_                  = Name -> MetaM (Core Phases)
forall {k} (a :: k). Name -> MetaM (Core a)
dataCon Name
allPhasesDataConName

rep_complete_sig :: [LocatedN Name]
                 -> Maybe (LocatedN Name)
                 -> SrcSpan
                 -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_complete_sig :: [GenLocated SrcSpanAnnN Name]
-> Maybe (GenLocated SrcSpanAnnN Name)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_complete_sig [GenLocated SrcSpanAnnN Name]
cls Maybe (GenLocated SrcSpanAnnN Name)
mty SrcSpan
loc
  = do { 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
       ; cls' <- repList nameTyConName lookupLOcc cls
       ; sig <- repPragComplete cls' mty'
       ; return [(loc, sig)] }

-------------------------------------------------------
--                      Types
-------------------------------------------------------

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 {k} (a :: k). 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 {k} (a :: k). 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 spec') <- Specificity -> MetaM (Core Specificity)
rep_flag Specificity
spec
                                            ; rep2 plainInvisTVName  [nm, spec'] }
    repKindedTV :: Core Name
-> Specificity
-> Core (M Type)
-> MetaM (Core (M (TyVarBndr Specificity)))
repKindedTV (MkC CoreExpr
nm) Specificity
spec (MkC CoreExpr
ki) = do { (MkC spec') <- Specificity -> MetaM (Core Specificity)
rep_flag Specificity
spec
                                            ; rep2 kindedInvisTVName [nm, spec', 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 []

instance RepTV (HsBndrVis GhcRn) TH.BndrVis where
    tyVarBndrName :: Name
tyVarBndrName = Name
tyVarBndrVisTyConName
    repPlainTV :: Core Name
-> HsBndrVis (GhcPass 'Renamed)
-> MetaM (Core (M (TyVarBndr BndrVis)))
repPlainTV  (MkC CoreExpr
nm) HsBndrVis (GhcPass 'Renamed)
vis          = do { (MkC vis') <- HsBndrVis (GhcPass 'Renamed) -> MetaM (Core BndrVis)
rep_bndr_vis HsBndrVis (GhcPass 'Renamed)
vis
                                           ; rep2 plainBndrTVName  [nm, vis'] }
    repKindedTV :: Core Name
-> HsBndrVis (GhcPass 'Renamed)
-> Core (M Type)
-> MetaM (Core (M (TyVarBndr BndrVis)))
repKindedTV (MkC CoreExpr
nm) HsBndrVis (GhcPass 'Renamed)
vis (MkC CoreExpr
ki) = do { (MkC vis') <- HsBndrVis (GhcPass 'Renamed) -> MetaM (Core BndrVis)
rep_bndr_vis HsBndrVis (GhcPass 'Renamed)
vis
                                           ; rep2 kindedBndrTVName [nm, vis', ki] }

rep_bndr_vis :: HsBndrVis GhcRn -> MetaM (Core TH.BndrVis)
rep_bndr_vis :: HsBndrVis (GhcPass 'Renamed) -> MetaM (Core BndrVis)
rep_bndr_vis (HsBndrRequired XBndrRequired (GhcPass 'Renamed)
_)  = Name -> [CoreExpr] -> MetaM (Core BndrVis)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
bndrReqName []
rep_bndr_vis (HsBndrInvisible XBndrInvisible (GhcPass 'Renamed)
_) = Name -> [CoreExpr] -> MetaM (Core BndrVis)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
bndrInvisName []

addHsOuterFamEqnTyVarBinds ::
     HsOuterFamEqnTyVarBndrs GhcRn
  -> (Core (Maybe [M (TH.TyVarBndr ())]) -> MetaM (Core (M a)))
  -> MetaM (Core (M a))
addHsOuterFamEqnTyVarBinds :: forall {k} (a :: k).
HsOuterFamEqnTyVarBndrs (GhcPass 'Renamed)
-> (Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterFamEqnTyVarBinds HsOuterFamEqnTyVarBndrs (GhcPass 'Renamed)
outer_bndrs Core (Maybe [M (TyVarBndr ())]) -> MetaM (Core (M a))
thing_inside = do
  elt_ty <- Name -> MetaM Type
wrapName Name
tyVarBndrUnitTyConName
  case outer_bndrs of
    HsOuterImplicit{hso_ximplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
hso_ximplicit = XHsOuterImplicit (GhcPass 'Renamed)
imp_tvs} ->
      FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall {k} (a :: k).
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
ReuseBoundNames [Name]
XHsOuterImplicit (GhcPass 'Renamed)
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 (GhcPass 'Renamed))]
exp_bndrs} ->
      FreshOrReuse
-> [LHsTyVarBndr () (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr () (NoGhcTc (GhcPass 'Renamed))]
[LHsTyVarBndr () (GhcPass 'Renamed)]
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.TyVarBndr TH.Specificity)] -> MetaM (Core (M a)))
  -> MetaM (Core (M a))
addHsOuterSigTyVarBinds :: forall {k} (a :: k).
HsOuterSigTyVarBndrs (GhcPass 'Renamed)
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterSigTyVarBinds HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a))
thing_inside = case HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs of
  HsOuterImplicit{hso_ximplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
hso_ximplicit = XHsOuterImplicit (GhcPass 'Renamed)
imp_tvs} ->
    do th_nil <- Name
-> [Core (M (TyVarBndr Specificity))]
-> MetaM (Core [M (TyVarBndr Specificity)])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
tyVarBndrSpecTyConName []
       addSimpleTyVarBinds FreshNamesOnly imp_tvs $ thing_inside th_nil
  HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc (GhcPass 'Renamed))]
exp_bndrs} ->
    FreshOrReuse
-> [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr Specificity (NoGhcTc (GhcPass 'Renamed))]
[LHsTyVarBndr Specificity (GhcPass 'Renamed)]
exp_bndrs Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a))
thing_inside

-- | If a type implicitly quantifies its outermost type variables, return
-- 'True' if the list of implicitly bound type variables is empty. If a type
-- explicitly quantifies its outermost type variables, always return 'True'.
--
-- This is used in various places to determine if a Template Haskell 'Type'
-- should be headed by a 'ForallT' or not.
nullOuterImplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterImplicit :: HsOuterSigTyVarBndrs (GhcPass 'Renamed) -> Bool
nullOuterImplicit (HsOuterImplicit{hso_ximplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
hso_ximplicit = XHsOuterImplicit (GhcPass 'Renamed)
imp_tvs}) = [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
XHsOuterImplicit (GhcPass 'Renamed)
imp_tvs
nullOuterImplicit (HsOuterExplicit{})                        = Bool
True
  -- Vacuously true, as there is no implicit quantification

-- | If a type explicitly quantifies its outermost type variables, return
-- 'True' if the list of explicitly bound type variables is empty. If a type
-- implicitly quantifies its outermost type variables, always return 'True'.
--
-- This is used in various places to determine if a Template Haskell 'Type'
-- should be headed by a 'ForallT' or not.
nullOuterExplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool
nullOuterExplicit :: HsOuterSigTyVarBndrs (GhcPass 'Renamed) -> Bool
nullOuterExplicit (HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc (GhcPass 'Renamed))]
exp_bndrs}) = [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Renamed))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity (NoGhcTc (GhcPass 'Renamed))]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Renamed))]
exp_bndrs
nullOuterExplicit (HsOuterImplicit{})                      = Bool
True
  -- Vacuously true, as there is no outermost explicit quantification

-- Do we want to generate fresh names for type variables
-- or reuse the ones that are already in scope?
data FreshOrReuse
  = FreshNamesOnly
    -- Generate fresh names for all type variables, regardless of existing
    -- variables in the MetaEnv.
    --
    -- This is the default strategy.

  | ReuseBoundNames
    -- Generate fresh names for type variables not in the MetaEnv.
    -- Where a name is already bound in the MetaEnv, use that existing binding;
    -- do not create a new one with a fresh name.
    --
    -- This is the strategy used for data/newtype declarations and type family
    -- instances, so that the nested type variables work right:
    --
    --     class C a where
    --       type W a b
    --     instance C (T a) where
    --       type W (T a) b = blah
    --
    -- The 'a' in the type instance is the one bound by the instance decl
    --
    -- Test cases: TH_reifyExplicitForAllFams T9081 T9199 T10811

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 =
  -- Make fresh names for the ones that are not already in scope
  -- This makes things work for associated types
  do { 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
     ; mkGenSyms (filterOut (`elemNameEnv` env) names) }

addSimpleTyVarBinds :: FreshOrReuse
                    -> [Name]             -- the binders to be added
                    -> MetaM (Core (M a)) -- action in the ext env
                    -> MetaM (Core (M a))
addSimpleTyVarBinds :: forall {k} (a :: k).
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
fresh_or_reuse [Name]
names MetaM (Core (M a))
thing_inside
  = do { fresh_names <- FreshOrReuse -> [Name] -> MetaM [GenSymBind]
mkGenSyms' FreshOrReuse
fresh_or_reuse [Name]
names
       ; term <- addBinds fresh_names thing_inside
       ; wrapGenSyms fresh_names term }

addHsTyVarBinds :: forall flag flag' a. RepTV flag flag'
                => FreshOrReuse
                -> [LHsTyVarBndr flag GhcRn] -- the binders to be added
                -> (Core [(M (TH.TyVarBndr flag'))] -> MetaM (Core (M a))) -- action in the ext env
                -> MetaM (Core (M a))
addHsTyVarBinds :: forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
fresh_or_reuse [LHsTyVarBndr flag (GhcPass 'Renamed)]
exp_tvs Core [M (TyVarBndr flag')] -> MetaM (Core (M a))
thing_inside
  = do { fresh_exp_names <- FreshOrReuse -> [Name] -> MetaM [GenSymBind]
mkGenSyms' FreshOrReuse
fresh_or_reuse ([LHsTyVarBndr flag (GhcPass 'Renamed)] -> [IdP (GhcPass 'Renamed)]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr flag (GhcPass 'Renamed)]
exp_tvs)
       ; term <- addBinds fresh_exp_names $
                 do { kbs <- repListM (tyVarBndrName @flag @flag') repTyVarBndr
                                      exp_tvs
                    ; thing_inside kbs }
       ; wrapGenSyms fresh_exp_names term }

addQTyVarBinds :: FreshOrReuse
               -> LHsQTyVars GhcRn -- the binders to be added
               -> (Core [(M (TH.TyVarBndr TH.BndrVis))] -> MetaM (Core (M a))) -- action in the ext env
               -> MetaM (Core (M a))
addQTyVarBinds :: forall {k} (a :: k).
FreshOrReuse
-> LHsQTyVars (GhcPass 'Renamed)
-> (Core [M (TyVarBndr BndrVis)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addQTyVarBinds FreshOrReuse
fresh_or_reuse LHsQTyVars (GhcPass 'Renamed)
qtvs Core [M (TyVarBndr BndrVis)] -> MetaM (Core (M a))
thing_inside =
  let HsQTvs { hsq_ext :: forall pass. LHsQTyVars pass -> XHsQTvs pass
hsq_ext      = XHsQTvs (GhcPass 'Renamed)
imp_tvs
             , hsq_explicit :: forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsq_explicit = [LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)]
exp_tvs }
        = LHsQTyVars (GhcPass 'Renamed)
qtvs
  in FreshOrReuse
-> [LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)]
-> [Name]
-> (Core [M (TyVarBndr BndrVis)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> [Name]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyVarBinds FreshOrReuse
fresh_or_reuse [LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)]
exp_tvs [Name]
XHsQTvs (GhcPass 'Renamed)
imp_tvs Core [M (TyVarBndr BndrVis)] -> MetaM (Core (M a))
thing_inside

addTyVarBinds :: RepTV flag flag'
              => FreshOrReuse
              -> [LHsTyVarBndr flag GhcRn] -- the binders to be added
              -> [Name]
              -> (Core [(M (TH.TyVarBndr flag'))] -> MetaM (Core (M a))) -- action in the ext env
              -> MetaM (Core (M a))
-- gensym a list of type variables and enter them into the meta environment;
-- the computations passed as the second argument is executed in that extended
-- meta environment and gets the *new* names on Core-level as an argument
addTyVarBinds :: forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> [Name]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyVarBinds FreshOrReuse
fresh_or_reuse [LHsTyVarBndr flag (GhcPass 'Renamed)]
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 {k} (a :: k).
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 (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
fresh_or_reuse [LHsTyVarBndr flag (GhcPass 'Renamed)]
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

-- | Represent a type variable binder
repTyVarBndr :: RepTV flag flag'
             => LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TH.TyVarBndr flag')))
repTyVarBndr :: forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag (GhcPass 'Renamed)
-> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr (L SrcSpanAnnA
_ (HsTvb XTyVarBndr (GhcPass 'Renamed)
_ flag
fl HsBndrVar (GhcPass 'Renamed)
bvar HsBndrKind (GhcPass 'Renamed)
bkind)) = do
  nm' <- HsBndrVar (GhcPass 'Renamed) -> MetaM (Core Name)
repHsBndrVar HsBndrVar (GhcPass 'Renamed)
bvar
  case bkind of
    HsBndrNoKind XBndrNoKind (GhcPass 'Renamed)
_ ->
      Core Name
-> flag -> ReaderT MetaWrappers DsM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
Core Name -> flag -> MetaM (Core (M (TyVarBndr flag')))
repPlainTV Core Name
nm' flag
fl
    HsBndrKind XBndrKind (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
ki -> do
      ki' <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
ki
      repKindedTV nm' fl ki'

repHsBndrVar :: HsBndrVar GhcRn -> MetaM (Core TH.Name)
repHsBndrVar :: HsBndrVar (GhcPass 'Renamed) -> MetaM (Core Name)
repHsBndrVar (HsBndrVar XBndrVar (GhcPass 'Renamed)
_ (L SrcSpanAnnN
_ Name
nm)) =
  Name -> MetaM (Core Name)
lookupBinder Name
nm
repHsBndrVar (HsBndrWildCard XBndrWildCard (GhcPass 'Renamed)
_) = do
  u <- DsM Unique -> ReaderT MetaWrappers DsM Unique
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 Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
  lift $ globalVarLocal u (mkTyVarOcc "_")

-- represent a type context
--
repLContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M TH.Cxt))
repLContext :: Maybe (LHsContext (GhcPass 'Renamed)) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext (GhcPass 'Renamed))
Nothing = [LHsType (GhcPass 'Renamed)] -> MetaM (Core (M Cxt))
repContext []
repLContext (Just LHsContext (GhcPass 'Renamed)
ctxt) = [LHsType (GhcPass 'Renamed)] -> MetaM (Core (M Cxt))
repContext (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))]
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))]
forall l e. GenLocated l e -> e
unLoc LHsContext (GhcPass 'Renamed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))]
ctxt)

repContext :: HsContext GhcRn -> MetaM (Core (M TH.Cxt))
repContext :: [LHsType (GhcPass 'Renamed)] -> MetaM (Core (M Cxt))
repContext [LHsType (GhcPass 'Renamed)]
ctxt = do preds <- Name
-> (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
    -> MetaM (Core (M Type)))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))]
-> MetaM (Core [M Type])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
typeTyConName LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
-> MetaM (Core (M Type))
repLTy [LHsType (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))]
ctxt
                     repCtxt preds

repHsSigType :: LHsSigType GhcRn -> MetaM (Core (M TH.Type))
repHsSigType :: LHsSigType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repHsSigType (L SrcSpanAnnA
_ (HsSig { sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs (GhcPass 'Renamed)
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType (GhcPass 'Renamed)
body }))
  | (Maybe (LHsContext (GhcPass 'Renamed))
ctxt, LHsType (GhcPass 'Renamed)
tau) <- LHsType (GhcPass 'Renamed)
-> (Maybe (LHsContext (GhcPass 'Renamed)),
    LHsType (GhcPass 'Renamed))
forall (pass :: Pass).
LHsType (GhcPass pass)
-> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
splitLHsQualTy LHsType (GhcPass 'Renamed)
body
  = HsOuterSigTyVarBndrs (GhcPass 'Renamed)
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall {k} (a :: k).
HsOuterSigTyVarBndrs (GhcPass 'Renamed)
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsOuterSigTyVarBinds HsOuterSigTyVarBndrs (GhcPass 'Renamed)
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 { th_ctxt <- Maybe (LHsContext (GhcPass 'Renamed)) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext (GhcPass 'Renamed))
ctxt
       ; th_tau  <- repLTy tau
       ; if nullOuterExplicit outer_bndrs && null (fromMaybeContext ctxt)
         then pure th_tau
         else repTForall th_outer_bndrs th_ctxt th_tau }

-- yield the representation of a list of types
repLTys :: [LHsType GhcRn] -> MetaM [Core (M TH.Type)]
repLTys :: [LHsType (GhcPass 'Renamed)] -> MetaM [Core (M Type)]
repLTys [LHsType (GhcPass 'Renamed)]
tys = (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
 -> MetaM (Core (M Type)))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))]
-> 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 LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
-> MetaM (Core (M Type))
repLTy [LHsType (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))]
tys

-- represent a type
repLTy :: LHsType GhcRn -> MetaM (Core (M TH.Type))
repLTy :: LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
ty = HsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repTy (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
-> HsType (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc LHsType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
ty)

-- Desugar a type headed by an invisible forall (e.g., @forall a. a@) or
-- a context (e.g., @Show a => a@) into a ForallT from L.H.TH.Syntax.
-- In other words, the argument to this function is always an
-- @HsForAllTy HsForAllInvis{}@ or @HsQualTy@.
-- Types headed by visible foralls (which are desugared to ForallVisT) are
-- handled separately in repTy.
repForallT :: HsType GhcRn -> MetaM (Core (M TH.Type))
repForallT :: HsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repForallT HsType (GhcPass 'Renamed)
ty
 | ([LHsTyVarBndr Specificity (GhcPass 'Renamed)]
tvs, Maybe (LHsContext (GhcPass 'Renamed))
ctxt, LHsType (GhcPass 'Renamed)
tau) <- LHsType (GhcPass 'Renamed)
-> ([LHsTyVarBndr Specificity (GhcPass 'Renamed)],
    Maybe (LHsContext (GhcPass 'Renamed)), LHsType (GhcPass 'Renamed))
forall (p :: Pass).
LHsType (GhcPass p)
-> ([LHsTyVarBndr Specificity (GhcPass p)],
    Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
splitLHsSigmaTyInvis (HsType (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsType (GhcPass 'Renamed)
ty)
 = FreshOrReuse
-> [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
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 { ctxt1  <- Maybe (LHsContext (GhcPass 'Renamed)) -> MetaM (Core (M Cxt))
repLContext Maybe (LHsContext (GhcPass 'Renamed))
ctxt
      ; tau1   <- repLTy tau
      ; repTForall bndrs ctxt1 tau1 -- forall a. C a => {...}
      }

repTy :: HsType GhcRn -> MetaM (Core (M TH.Type))
repTy :: HsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repTy ty :: HsType (GhcPass 'Renamed)
ty@(HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllTelescope (GhcPass 'Renamed)
tele, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType (GhcPass 'Renamed)
body }) =
  case HsForAllTelescope (GhcPass 'Renamed)
tele of
    HsForAllInvis{} -> HsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repForallT HsType (GhcPass 'Renamed)
ty
    HsForAllVis { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () (GhcPass 'Renamed)]
tvs } ->
      FreshOrReuse
-> [LHsTyVarBndr () (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr () (GhcPass 'Renamed)]
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 body1 <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
body
         repTForallVis bndrs body1
repTy ty :: HsType (GhcPass 'Renamed)
ty@(HsQualTy {}) = HsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repForallT HsType (GhcPass 'Renamed)
ty

repTy (HsTyVar XTyVar (GhcPass 'Renamed)
_ PromotionFlag
_ (L SrcSpanAnnN
_ (WithUserRdr RdrName
_ 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
  | Name
n Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey              = MetaM (Core (M Type))
repTequality
  | NameSpace -> Bool
isVarNameSpace     NameSpace
ns = do tv1 <- Name -> MetaM (Core Name)
lookupOcc Name
n
                               repTvar tv1
  | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = do dc1 <- Name -> MetaM (Core Name)
lookupOcc Name
n
                               repPromotedDataCon dc1
  | NameSpace -> Bool
isTcClsNameSpace   NameSpace
ns = do tc1 <- Name -> MetaM (Core Name)
lookupOcc Name
n
                               repNamedTyCon tc1
  | Bool
otherwise = String -> MetaM (Core (M Type))
forall a. HasCallStack => String -> a
panic String
"repTy: HsTyVar: unknown namespace"
  where
    occ :: OccName
occ = Name -> OccName
nameOccName Name
n
    ns :: NameSpace
ns  = OccName -> NameSpace
occNameSpace OccName
occ

repTy (HsAppTy XAppTy (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
f LHsType (GhcPass 'Renamed)
a)       = do
                                f1 <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
f
                                a1 <- repLTy a
                                repTapp f1 a1
repTy (HsAppKindTy XAppKindTy (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
ty LHsType (GhcPass 'Renamed)
ki) = do
                                ty1 <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
ty
                                ki1 <- repLTy ki
                                repTappKind ty1 ki1
repTy (HsFunTy XFunTy (GhcPass 'Renamed)
_ HsMultAnn (GhcPass 'Renamed)
w LHsType (GhcPass 'Renamed)
f LHsType (GhcPass 'Renamed)
a) = do
                            f1   <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
f
                            a1   <- repLTy a
                            case multAnnToHsType w of
                              Maybe (LHsType (GhcPass 'Renamed))
Nothing -> do
                                tcon <- MetaM (Core (M Type))
repArrowTyCon
                                repTapps tcon [f1, a1]
                              Just LHsType (GhcPass 'Renamed)
m -> do
                                w1 <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
m
                                tcon <- repMulArrowTyCon
                                repTapps tcon [w1, f1, a1]
repTy (HsListTy XListTy (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
t)        = do
                                t1   <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
t
                                tcon <- repListTyCon
                                repTapp tcon t1
repTy (HsTupleTy XTupleTy (GhcPass 'Renamed)
_ HsTupleSort
HsUnboxedTuple [LHsType (GhcPass 'Renamed)]
tys) = do
                                tys1 <- [LHsType (GhcPass 'Renamed)] -> MetaM [Core (M Type)]
repLTys [LHsType (GhcPass 'Renamed)]
tys
                                tcon <- repUnboxedTupleTyCon (length tys)
                                repTapps tcon tys1
repTy (HsTupleTy XTupleTy (GhcPass 'Renamed)
_ HsTupleSort
_ [LHsType (GhcPass 'Renamed)]
tys)   = do tys1 <- [LHsType (GhcPass 'Renamed)] -> MetaM [Core (M Type)]
repLTys [LHsType (GhcPass 'Renamed)]
tys
                                 tcon <- repTupleTyCon (length tys)
                                 repTapps tcon tys1
repTy (HsSumTy XSumTy (GhcPass 'Renamed)
_ [LHsType (GhcPass 'Renamed)]
tys)       = do tys1 <- [LHsType (GhcPass 'Renamed)] -> MetaM [Core (M Type)]
repLTys [LHsType (GhcPass 'Renamed)]
tys
                                 tcon <- repUnboxedSumTyCon (length tys)
                                 repTapps tcon tys1
repTy (HsOpTy XOpTy (GhcPass 'Renamed)
_ PromotionFlag
prom LHsType (GhcPass 'Renamed)
ty1 XRec (GhcPass 'Renamed) (IdOccP (GhcPass 'Renamed))
n LHsType (GhcPass 'Renamed)
ty2) = LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy ((PromotionFlag
-> IdP (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
prom (GenLocated SrcSpanAnnN (WithUserRdr Name) -> Name
forall a. NamedThing a => a -> Name
getName XRec (GhcPass 'Renamed) (IdOccP (GhcPass 'Renamed))
GenLocated SrcSpanAnnN (WithUserRdr Name)
n) LHsType (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy` LHsType (GhcPass 'Renamed)
ty1)
                                   LHsType (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy` LHsType (GhcPass 'Renamed)
ty2)
repTy (HsParTy XParTy (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
t)         = LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
t
repTy (HsStarTy XStarTy (GhcPass 'Renamed)
_ Bool
_) =  MetaM (Core (M Type))
repTStar
repTy (HsKindSig XKindSig (GhcPass 'Renamed)
_ LHsType (GhcPass 'Renamed)
t LHsType (GhcPass 'Renamed)
k)     = do
                                t1 <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy LHsType (GhcPass 'Renamed)
t
                                k1 <- repLTy k
                                repTSig t1 k1
repTy (HsSpliceTy (HsUntypedSpliceNested Name
n) HsUntypedSplice (GhcPass 'Renamed)
_) = Name -> MetaM (Core (M Type))
forall {k} (a :: k). Name -> MetaM (Core a)
rep_splice Name
n
repTy t :: HsType (GhcPass 'Renamed)
t@(HsSpliceTy (HsUntypedSpliceTop ThModFinalizers
_ GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
_) HsUntypedSplice (GhcPass 'Renamed)
_) = String -> SDoc -> MetaM (Core (M Type))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repTy: top level splice" (HsType (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType (GhcPass 'Renamed)
t)
repTy (HsExplicitListTy XExplicitListTy (GhcPass 'Renamed)
_ PromotionFlag
_ [LHsType (GhcPass 'Renamed)]
tys) = do
                                    tys1 <- [LHsType (GhcPass 'Renamed)] -> MetaM [Core (M Type)]
repLTys [LHsType (GhcPass 'Renamed)]
tys
                                    repTPromotedList tys1
repTy (HsExplicitTupleTy XExplicitTupleTy (GhcPass 'Renamed)
_ PromotionFlag
_ [LHsType (GhcPass 'Renamed)]
tys) = do
                                    tys1 <- [LHsType (GhcPass 'Renamed)] -> MetaM [Core (M Type)]
repLTys [LHsType (GhcPass 'Renamed)]
tys
                                    tcon <- repPromotedTupleTyCon (length tys)
                                    repTapps tcon tys1
repTy (HsTyLit XTyLit (GhcPass 'Renamed)
_ HsTyLit (GhcPass 'Renamed)
lit) = do
                          lit' <- HsTyLit (GhcPass 'Renamed) -> MetaM (Core (M TyLit))
forall (p :: Pass). HsTyLit (GhcPass p) -> MetaM (Core (M TyLit))
repTyLit HsTyLit (GhcPass 'Renamed)
lit
                          repTLit lit'
repTy (HsWildCardTy XWildCardTy (GhcPass 'Renamed)
_) = MetaM (Core (M Type))
repTWildCard
repTy (HsIParamTy XIParamTy (GhcPass 'Renamed)
_ XRec (GhcPass 'Renamed) HsIPName
n LHsType (GhcPass 'Renamed)
t) = do
                             n' <- HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name (GenLocated EpAnnCO HsIPName -> HsIPName
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass 'Renamed) HsIPName
GenLocated EpAnnCO HsIPName
n)
                             t' <- repLTy t
                             repTImplicitParam n' t'

repTy HsType (GhcPass 'Renamed)
ty                      = ThRejectionReason -> MetaM (Core (M Type))
forall a. ThRejectionReason -> MetaM a
notHandled (HsType (GhcPass 'Renamed) -> ThRejectionReason
ThExoticFormOfType HsType (GhcPass 'Renamed)
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 <- MetaM Platform
getPlatform
                         rep2 numTyLitName [mkIntegerExpr platform i]
repTyLit (HsStrTy XStrTy (GhcPass p)
_ FastString
s) = do { s' <- FastString -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
mkStringExprFS FastString
s
                            ; rep2 strTyLitName [s']
                            }
repTyLit (HsCharTy XCharTy (GhcPass p)
_ Char
c) = do { 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)
                             ; rep2 charTyLitName [c']
                             }

-- | Represent a type wrapped in a Maybe
repMaybeLTy :: Maybe (LHsKind GhcRn)
            -> MetaM (Core (Maybe (M TH.Type)))
repMaybeLTy :: Maybe (LHsType (GhcPass 'Renamed)) -> MetaM (Core (Maybe (M Type)))
repMaybeLTy Maybe (LHsType (GhcPass 'Renamed))
m = do
  k_ty <- Name -> MetaM Type
wrapName Name
kindTyConName
  repMaybeT k_ty repLTy m

repRole :: LocatedAn NoEpAnns (Maybe Role) -> MetaM (Core TH.Role)
repRole :: LocatedAn NoEpAnns (Maybe Role)
-> ReaderT MetaWrappers DsM (Core Role)
repRole (L EpAnnCO
_ (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 EpAnnCO
_ (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 EpAnnCO
_ (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 EpAnnCO
_ Maybe Role
Nothing)                 = Name -> [CoreExpr] -> ReaderT MetaWrappers DsM (Core Role)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
inferRName []

-----------------------------------------------------------------------------
--              Splices
-----------------------------------------------------------------------------

-- See Note [How brackets and nested splices are handled] in GHC.Tc.Gen.Splice
-- We return a CoreExpr of any old type; the context should know

rep_splice :: Name -> MetaM (Core a)
rep_splice :: forall {k} (a :: k). Name -> MetaM (Core a)
rep_splice Name
splice_name
 = do { 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 mb_val of
           Just (DsSplice HsExpr GhcTc
e) -> do { 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
                                   ; return (MkC e') }
           Maybe DsMetaVal
_ -> String -> SDoc -> ReaderT MetaWrappers DsM (Core a)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"HsSplice" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
splice_name) }
                        -- Should not happen; statically checked

-----------------------------------------------------------------------------
--              Expressions
-----------------------------------------------------------------------------

repLEs :: [LHsExpr GhcRn] -> MetaM (Core [(M TH.Exp)])
repLEs :: [LHsExpr (GhcPass 'Renamed)] -> MetaM (Core [M Exp])
repLEs [LHsExpr (GhcPass 'Renamed)]
es = Name
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
    -> MetaM (Core (M Exp)))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> MetaM (Core [M Exp])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
expTyConName LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> MetaM (Core (M Exp))
repLE [LHsExpr (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
es

-- FIXME: some of these panics should be converted into proper error messages
--        unless we can make sure that constructs, which are plainly not
--        supported in TH already lead to error messages at an earlier stage
repLE :: LHsExpr GhcRn -> MetaM (Core (M TH.Exp))
repLE :: LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE (L SrcSpanAnnA
loc HsExpr (GhcPass 'Renamed)
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. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc)) (HsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repE HsExpr (GhcPass 'Renamed)
e)

repE :: HsExpr GhcRn -> MetaM (Core (M TH.Exp))
repE :: HsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repE (HsVar XVar (GhcPass 'Renamed)
_ (L SrcSpanAnnN
_ (WithUserRdr RdrName
_ Name
x))) =
  do { 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 mb_val of
        Maybe DsMetaVal
Nothing            -> do { 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
                                 ; repVarOrCon x 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 { 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
                                 ; return (MkC e') } }
repE (HsHole (HoleVar (L SrcSpanAnnN
_ RdrName
uv))) = do
  name <- RdrName -> MetaM (Core Name)
repRdrName RdrName
uv
  repUnboundVar name
repE (HsHole XHole (GhcPass 'Renamed)
HoleKind
HoleError) = String -> MetaM (Core (M Exp))
forall a. HasCallStack => String -> a
panic String
"repE: HoleError"
repE (HsIPVar XIPVar (GhcPass 'Renamed)
_ 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 (GhcPass 'Renamed)
_ FastString
s) = FastString -> MetaM (Core (M Exp))
repOverLabel FastString
s


        -- Remember, we're desugaring renamer output here, so
        -- HsOverlit can definitely occur
repE (HsOverLit XOverLitE (GhcPass 'Renamed)
_ HsOverLit (GhcPass 'Renamed)
l) = do { a <- HsOverLit (GhcPass 'Renamed) -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit (GhcPass 'Renamed)
l; repLit a }
repE (HsLit XLitE (GhcPass 'Renamed)
_ HsLit (GhcPass 'Renamed)
l)     = do { a <- HsLit (GhcPass 'Renamed) -> MetaM (Core Lit)
repLiteral HsLit (GhcPass 'Renamed)
l;           repLit a }
repE (HsLam XLam (GhcPass 'Renamed)
_ HsLamVariant
LamSingle (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnLW
_ [GenLocated
  SrcSpanAnnA
  (Match
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
m] })) = LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> MetaM (Core (M Exp))
repLambda LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
GenLocated
  SrcSpanAnnA
  (Match
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
m
repE e :: HsExpr (GhcPass 'Renamed)
e@(HsLam XLam (GhcPass 'Renamed)
_ HsLamVariant
LamSingle (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnLW
_ [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
_ })) = String -> SDoc -> MetaM (Core (M Exp))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repE: HsLam with multiple alternatives" (HsExpr (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr (GhcPass 'Renamed)
e)
repE (HsLam XLam (GhcPass 'Renamed)
_ HsLamVariant
LamCase (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnLW
_ [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
ms }))
                   = do { ms' <- (GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> ReaderT MetaWrappers DsM (Core (M Match)))
-> [GenLocated
      SrcSpanAnnA
      (Match
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> 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 (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (Core (M Match))
GenLocated
  SrcSpanAnnA
  (Match
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatchTup [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
ms
                        ; core_ms <- coreListM matchTyConName ms'
                        ; repLamCase core_ms }
repE (HsLam XLam (GhcPass 'Renamed)
_ HsLamVariant
LamCases (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnLW
_ [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
ms) }))
                   = do { ms' <- (GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> ReaderT MetaWrappers DsM (Core (M Clause)))
-> [GenLocated
      SrcSpanAnnA
      (Match
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> 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 (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (Core (M Clause))
GenLocated
  SrcSpanAnnA
  (Match
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClauseTup [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
ms
                        ; core_ms <- coreListM matchTyConName ms'
                        ; repLamCases core_ms }
repE (HsApp XApp (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
x LHsExpr (GhcPass 'Renamed)
y)   = do {a <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
x; b <- repLE y; repApp a b}
repE (HsAppType XAppTypeE (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
e LHsWcType (NoGhcTc (GhcPass 'Renamed))
t) = do { a <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e
                            ; s <- repLTy (hswc_body t)
                            ; repAppType a s }

repE (OpApp XOpApp (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
e1 LHsExpr (GhcPass 'Renamed)
op LHsExpr (GhcPass 'Renamed)
e2) =
  do { arg1 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e1;
       arg2 <- repLE e2;
       the_op <- repLE op ;
       repInfixApp arg1 the_op arg2 }
repE (NegApp XNegApp (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
x SyntaxExpr (GhcPass 'Renamed)
_)      = do
                              a         <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
x
                              negateVar <- lookupOcc negateName >>= repVar
                              negateVar `repApp` a
repE (HsPar XPar (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
x)            = LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
x
repE (SectionL XSectionL (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
x LHsExpr (GhcPass 'Renamed)
y)       = do { a <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
x; b <- repLE y; repSectionL a b }
repE (SectionR XSectionR (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
x LHsExpr (GhcPass 'Renamed)
y)       = do { a <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
x; b <- repLE y; repSectionR a b }
repE (HsCase XCase (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
e (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnLW
_ [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
ms) }))
                          = do { arg <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e
                               ; ms2 <- mapM repMatchTup ms
                               ; core_ms2 <- coreListM matchTyConName ms2
                               ; repCaseE arg core_ms2 }
repE (HsIf XIf (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
x LHsExpr (GhcPass 'Renamed)
y LHsExpr (GhcPass 'Renamed)
z)       = do
                            a <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
x
                            b <- repLE y
                            c <- repLE z
                            repCond a b c
repE (HsMultiIf XMultiIf (GhcPass 'Renamed)
_ NonEmpty (LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed)))
alts)
  = do { (binds, alts') <- NonEmpty ([GenSymBind], Core (M (Guard, Exp)))
-> (NonEmpty [GenSymBind], NonEmpty (Core (M (Guard, Exp))))
forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
NE.unzip (NonEmpty ([GenSymBind], Core (M (Guard, Exp)))
 -> (NonEmpty [GenSymBind], NonEmpty (Core (M (Guard, Exp)))))
-> ReaderT
     MetaWrappers DsM (NonEmpty ([GenSymBind], Core (M (Guard, Exp))))
-> ReaderT
     MetaWrappers
     DsM
     (NonEmpty [GenSymBind], NonEmpty (Core (M (Guard, Exp))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenLocated
   EpAnnCO
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp))))
-> NonEmpty
     (GenLocated
        EpAnnCO
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> ReaderT
     MetaWrappers DsM (NonEmpty ([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) -> NonEmpty a -> m (NonEmpty b)
mapM LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
GenLocated
  EpAnnCO
  (GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
repLGRHS NonEmpty (LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed)))
NonEmpty
  (GenLocated
     EpAnnCO
     (GRHS
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
alts
       ; expr' <- repMultiIf (nonEmptyCoreList' alts')
       ; wrapGenSyms (concat binds) expr' }
repE (HsLet XLet (GhcPass 'Renamed)
_ HsLocalBinds (GhcPass 'Renamed)
bs LHsExpr (GhcPass 'Renamed)
e)       = do { (ss,ds) <- HsLocalBinds (GhcPass 'Renamed)
-> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds (GhcPass 'Renamed)
bs
                               ; e2 <- addBinds ss (repLE e)
                               ; z <- repLetE ds e2
                               ; wrapGenSyms ss z }

-- FIXME: I haven't got the types here right yet
repE e :: HsExpr (GhcPass 'Renamed)
e@(HsDo XDo (GhcPass 'Renamed)
_ HsDoFlavour
ctxt (L SrcSpanAnnLW
_ [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
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 { (ss,zs) <- [ExprLStmt (GhcPass 'Renamed)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
sts;
        e'      <- repDoE maybeModuleName (nonEmptyCoreList zs);
        wrapGenSyms ss e' }

 | HsDoFlavour
ListComp <- HsDoFlavour
ctxt
 = do { (ss,zs) <- [ExprLStmt (GhcPass 'Renamed)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
sts;
        e'      <- repComp (nonEmptyCoreList zs);
        wrapGenSyms ss e' }

 | MDoExpr Maybe ModuleName
maybeModuleName <- HsDoFlavour
ctxt
 = do { (ss,zs) <- [ExprLStmt (GhcPass 'Renamed)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
sts;
        e'      <- repMDoE maybeModuleName (nonEmptyCoreList zs);
        wrapGenSyms ss e' }

  | Bool
otherwise
  = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr (GhcPass 'Renamed) -> ThRejectionReason
ThMonadComprehensionSyntax HsExpr (GhcPass 'Renamed)
e)

repE (ExplicitList XExplicitList (GhcPass 'Renamed)
_ [LHsExpr (GhcPass 'Renamed)]
es) = do { xs <- [LHsExpr (GhcPass 'Renamed)] -> MetaM (Core [M Exp])
repLEs [LHsExpr (GhcPass 'Renamed)]
es; repListExp xs }
repE (ExplicitTuple XExplicitTuple (GhcPass 'Renamed)
_ [HsTupArg (GhcPass 'Renamed)]
es Boxity
boxity) =
  let tupArgToCoreExp :: HsTupArg GhcRn -> MetaM (Core (Maybe (M TH.Exp)))
      tupArgToCoreExp :: HsTupArg (GhcPass 'Renamed) -> MetaM (Core (Maybe (M Exp)))
tupArgToCoreExp HsTupArg (GhcPass 'Renamed)
a
        | (Present XPresent (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
e) <- HsTupArg (GhcPass 'Renamed)
a = do { e' <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e
                                  ; coreJustM expTyConName e' }
        | Bool
otherwise = Name -> MetaM (Core (Maybe (M Exp)))
forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
expTyConName

  in do { args <- (HsTupArg (GhcPass 'Renamed) -> MetaM (Core (Maybe (M Exp))))
-> [HsTupArg (GhcPass 'Renamed)]
-> 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 (GhcPass 'Renamed) -> MetaM (Core (Maybe (M Exp)))
tupArgToCoreExp [HsTupArg (GhcPass 'Renamed)]
es
        ; expTy <- wrapName  expTyConName
        ; let maybeExpQTy = TyCon -> [Type] -> Type
mkTyConApp TyCon
maybeTyCon [Type
expTy]
              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 isBoxed boxity
          then repTup listArg
          else repUnboxedTup listArg }

repE (ExplicitSum XExplicitSum (GhcPass 'Renamed)
_ Int
alt Int
arity LHsExpr (GhcPass 'Renamed)
e)
 = do { e1 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e
      ; repUnboxedSum e1 alt arity }

repE (RecordCon { rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
rcon_con = XRec (GhcPass 'Renamed) (ConLikeP (GhcPass 'Renamed))
c, rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = HsRecordBinds (GhcPass 'Renamed)
flds })
 = do { x <- GenLocated SrcSpanAnnN (WithUserRdr Name) -> MetaM (Core Name)
forall l. GenLocated l (WithUserRdr Name) -> MetaM (Core Name)
lookupWithUserRdrLOcc XRec (GhcPass 'Renamed) (ConLikeP (GhcPass 'Renamed))
GenLocated SrcSpanAnnN (WithUserRdr Name)
c;
        fs <- repFields flds;
        repRecCon x fs }
repE (RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr (GhcPass 'Renamed)
e, rupd_flds :: forall p. HsExpr p -> LHsRecUpdFields p
rupd_flds = RegularRecUpdFields { recUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdField p p]
recUpdFields = [LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)]
flds } })
 = do { x <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e;
        fs <- repUpdFields flds;
        repRecUpd x fs }
repE e :: HsExpr (GhcPass 'Renamed)
e@(RecordUpd { rupd_flds :: forall p. HsExpr p -> LHsRecUpdFields p
rupd_flds = OverloadedRecUpdFields {} })
  = do
      -- Not possible due to elimination in the renamer. See Note
      -- [Handling overloaded and rebindable constructs]
      String -> SDoc -> MetaM (Core (M Exp))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repE: unexpected overloaded record update" (SDoc -> MetaM (Core (M Exp))) -> SDoc -> MetaM (Core (M Exp))
forall a b. (a -> b) -> a -> b
$ HsExpr (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr (GhcPass 'Renamed)
e

repE (ExprWithTySig XExprWithTySig (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
e LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
wc_ty)
  = FreshOrReuse
-> [Name] -> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall {k} (a :: k).
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
FreshNamesOnly (LHsSigType (GhcPass 'Renamed) -> [Name]
get_scoped_tvs_from_sig LHsSigType (GhcPass 'Renamed)
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 { e1 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e
       ; t1 <- rep_ty_sig' sig_ty
       ; repSigExp e1 t1 }
  where
    sig_ty :: LHsSigType (GhcPass 'Renamed)
sig_ty = LHsSigWcType (GhcPass 'Renamed) -> LHsSigType (GhcPass 'Renamed)
forall (p :: Pass).
LHsSigWcType (GhcPass p) -> LHsSigType (GhcPass p)
dropWildCards LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
LHsSigWcType (GhcPass 'Renamed)
wc_ty

repE (ArithSeq XArithSeq (GhcPass 'Renamed)
_ Maybe (SyntaxExpr (GhcPass 'Renamed))
_ ArithSeqInfo (GhcPass 'Renamed)
aseq) =
  case ArithSeqInfo (GhcPass 'Renamed)
aseq of
    From LHsExpr (GhcPass 'Renamed)
e              -> do { ds1 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e; repFrom ds1 }
    FromThen LHsExpr (GhcPass 'Renamed)
e1 LHsExpr (GhcPass 'Renamed)
e2      -> do
                             ds1 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e1
                             ds2 <- repLE e2
                             repFromThen ds1 ds2
    FromTo   LHsExpr (GhcPass 'Renamed)
e1 LHsExpr (GhcPass 'Renamed)
e2      -> do
                             ds1 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e1
                             ds2 <- repLE e2
                             repFromTo ds1 ds2
    FromThenTo LHsExpr (GhcPass 'Renamed)
e1 LHsExpr (GhcPass 'Renamed)
e2 LHsExpr (GhcPass 'Renamed)
e3 -> do
                             ds1 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e1
                             ds2 <- repLE e2
                             ds3 <- repLE e3
                             repFromThenTo ds1 ds2 ds3

repE (HsTypedSplice XTypedSplice (GhcPass 'Renamed)
n LHsExpr (GhcPass 'Renamed)
_) = Name -> MetaM (Core (M Exp))
forall {k} (a :: k). Name -> MetaM (Core a)
rep_splice XTypedSplice (GhcPass 'Renamed)
Name
n
repE (HsUntypedSplice (HsUntypedSpliceNested Name
n) HsUntypedSplice (GhcPass 'Renamed)
_)  = Name -> MetaM (Core (M Exp))
forall {k} (a :: k). Name -> MetaM (Core a)
rep_splice Name
n
repE e :: HsExpr (GhcPass 'Renamed)
e@(HsUntypedSplice (HsUntypedSpliceTop ThModFinalizers
_ HsExpr (GhcPass 'Renamed)
_) HsUntypedSplice (GhcPass 'Renamed)
_) = String -> SDoc -> MetaM (Core (M Exp))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repE: top level splice" (HsExpr (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr (GhcPass 'Renamed)
e)
repE (HsStatic XStatic (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
e)        = LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
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 {k} (a :: k). 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 {k} (a :: k). Core a -> CoreExpr
unC
repE (HsGetField XGetField (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
e (L EpAnnCO
_ (DotFieldOcc XCDotFieldOcc (GhcPass 'Renamed)
_ (L SrcSpanAnnN
_ (FieldLabelString FastString
f))))) = do
  e1 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e
  repGetField e1 f
repE (HsProjection XProjection (GhcPass 'Renamed)
_ NonEmpty (DotFieldOcc (GhcPass 'Renamed))
xs) = NonEmpty FastString -> MetaM (Core (M Exp))
repProjection ((DotFieldOcc (GhcPass 'Renamed) -> FastString)
-> NonEmpty (DotFieldOcc (GhcPass 'Renamed)) -> 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)
-> (DotFieldOcc (GhcPass 'Renamed) -> FieldLabelString)
-> DotFieldOcc (GhcPass 'Renamed)
-> 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)
-> (DotFieldOcc (GhcPass 'Renamed)
    -> GenLocated SrcSpanAnnN FieldLabelString)
-> DotFieldOcc (GhcPass 'Renamed)
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotFieldOcc (GhcPass 'Renamed)
-> XRec (GhcPass 'Renamed) FieldLabelString
DotFieldOcc (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN FieldLabelString
forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel) NonEmpty (DotFieldOcc (GhcPass 'Renamed))
xs)
repE (HsEmbTy XEmbTy (GhcPass 'Renamed)
_ LHsWcType (NoGhcTc (GhcPass 'Renamed))
t) = do
  t1 <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy (HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc (GhcPass 'Renamed))
HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
t)
  rep2 typeEName [unC t1]
repE (HsQual XQual (GhcPass 'Renamed)
_ (L SrcSpanAnnC
_ [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
ctx) LHsExpr (GhcPass 'Renamed)
body) = do
  ctx' <- [LHsExpr (GhcPass 'Renamed)] -> MetaM (Core [M Exp])
repLEs [LHsExpr (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
ctx
  body' <- repLE body
  rep2 constrainedEName [unC ctx', unC body']
repE (HsForAll XForAll (GhcPass 'Renamed)
_ HsForAllTelescope (GhcPass 'Renamed)
tele LHsExpr (GhcPass 'Renamed)
body) =
  case HsForAllTelescope (GhcPass 'Renamed)
tele of
    HsForAllVis   XHsForAllVis (GhcPass 'Renamed)
_ [LHsTyVarBndr () (GhcPass 'Renamed)]
tvs -> Name
-> [LHsTyVarBndr () (GhcPass 'Renamed)] -> MetaM (Core (M Exp))
forall flag flag'.
RepTV flag flag' =>
Name
-> [LHsTyVarBndr flag (GhcPass 'Renamed)] -> MetaM (Core (M Exp))
mk_forall Name
forallVisEName [LHsTyVarBndr () (GhcPass 'Renamed)]
tvs
    HsForAllInvis XHsForAllInvis (GhcPass 'Renamed)
_ [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
tvs -> Name
-> [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
-> MetaM (Core (M Exp))
forall flag flag'.
RepTV flag flag' =>
Name
-> [LHsTyVarBndr flag (GhcPass 'Renamed)] -> MetaM (Core (M Exp))
mk_forall Name
forallEName    [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
tvs
  where
    mk_forall :: RepTV flag flag' => Name -> [LHsTyVarBndr flag GhcRn] -> MetaM (Core (M TH.Exp))
    mk_forall :: forall flag flag'.
RepTV flag flag' =>
Name
-> [LHsTyVarBndr flag (GhcPass 'Renamed)] -> MetaM (Core (M Exp))
mk_forall Name
forall_name [LHsTyVarBndr flag (GhcPass 'Renamed)]
tvs =
      FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M Exp)))
-> MetaM (Core (M Exp))
forall {k} flag flag' (a :: k).
RepTV flag flag' =>
FreshOrReuse
-> [LHsTyVarBndr flag (GhcPass 'Renamed)]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds FreshOrReuse
FreshNamesOnly [LHsTyVarBndr flag (GhcPass 'Renamed)]
tvs ((Core [M (TyVarBndr flag')] -> MetaM (Core (M Exp)))
 -> MetaM (Core (M Exp)))
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M Exp)))
-> MetaM (Core (M Exp))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr flag')]
bndrs -> do
        body' <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
body
        rep2 forall_name [unC bndrs, unC body']
repE (HsFunArr XFunArr (GhcPass 'Renamed)
_ HsMultAnnOf (LHsExpr (GhcPass 'Renamed)) (GhcPass 'Renamed)
mult LHsExpr (GhcPass 'Renamed)
arg LHsExpr (GhcPass 'Renamed)
res) = do
  fun  <- HsMultAnnOf
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
  (GhcPass 'Renamed)
-> MetaM (Core (M Exp))
repFunArrMult HsMultAnnOf (LHsExpr (GhcPass 'Renamed)) (GhcPass 'Renamed)
HsMultAnnOf
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
  (GhcPass 'Renamed)
mult
  arg' <- repLE arg
  res' <- repLE res
  repApps fun [arg', res']
repE e :: HsExpr (GhcPass 'Renamed)
e@(XExpr (ExpandedThingRn HsThingRn
o HsExpr (GhcPass 'Renamed)
x))
  | OrigExpr HsExpr (GhcPass 'Renamed)
e <- HsThingRn
o
  = do { 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 rebindable_on  -- See Note [Quotation and rebindable syntax]
         then repE x
         else repE e }
  | Bool
otherwise
  = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr (GhcPass 'Renamed) -> ThRejectionReason
ThExpressionForm HsExpr (GhcPass 'Renamed)
e)

repE (XExpr (PopErrCtxt (L SrcSpanAnnA
_ HsExpr (GhcPass 'Renamed)
e))) = HsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repE HsExpr (GhcPass 'Renamed)
e
repE (XExpr (HsRecSelRn (FieldOcc XCFieldOcc (GhcPass 'Renamed)
_ (L SrcSpanAnnN
_ Name
x)))) = HsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repE (LIdP (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
forall (p :: Pass).
IsPass p =>
LIdP (GhcPass p) -> HsExpr (GhcPass p)
mkHsVar (Name -> GenLocated SrcSpanAnnN Name
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA Name
x))

repE e :: HsExpr (GhcPass 'Renamed)
e@(HsPragE XPragE (GhcPass 'Renamed)
_ (HsPragSCC {}) LHsExpr (GhcPass 'Renamed)
_) = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr (GhcPass 'Renamed) -> ThRejectionReason
ThCostCentres HsExpr (GhcPass 'Renamed)
e)
repE e :: HsExpr (GhcPass 'Renamed)
e@(HsTypedBracket{})   = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr (GhcPass 'Renamed) -> ThRejectionReason
ThExpressionForm HsExpr (GhcPass 'Renamed)
e)
repE e :: HsExpr (GhcPass 'Renamed)
e@(HsUntypedBracket{}) = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr (GhcPass 'Renamed) -> ThRejectionReason
ThExpressionForm HsExpr (GhcPass 'Renamed)
e)
repE e :: HsExpr (GhcPass 'Renamed)
e@(HsProc{}) = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsExpr (GhcPass 'Renamed) -> ThRejectionReason
ThExpressionForm HsExpr (GhcPass 'Renamed)
e)

repFunArrMult :: HsMultAnnOf (LocatedA (HsExpr GhcRn)) GhcRn -> MetaM (Core (M TH.Exp))
repFunArrMult :: HsMultAnnOf
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
  (GhcPass 'Renamed)
-> MetaM (Core (M Exp))
repFunArrMult HsMultAnnOf
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
  (GhcPass 'Renamed)
mult = case HsMultAnnOf
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
  (GhcPass 'Renamed)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
multAnnToHsExpr HsMultAnnOf
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
  (GhcPass 'Renamed)
mult of
  Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
Nothing -> Name -> MetaM (Core (M Exp))
repConName Name
unrestrictedFunTyConName
  Just GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e -> do { fun <- Name -> MetaM (Core (M Exp))
repConName Name
fUNTyConName
               ; mult' <- repLE e
               ; repApp fun mult' }

repConName :: Name -> MetaM (Core (M TH.Exp))
repConName :: Name -> MetaM (Core (M Exp))
repConName Name
n = do
  core_name <- 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
  repCon core_name

{- Note [Quotation and rebindable syntax]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
  f = [| (* 3) |]

Because of Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr,
the renamer will expand (* 3) to (rightSection (*) 3), regardless of RebindableSyntax.
Then, concerning the TH quotation,

* If RebindableSyntax is off, we want the TH quote to generate the section (* 3),
  as the user originally wrote.

* If RebindableSyntax is on, we perhaps want the TH quote to generate
  (rightSection (*) 3), using whatever 'rightSection' is in scope, because
  (a) RebindableSyntax might not be on in the splicing context
  (b) Even if it is, 'rightSection' might not be in scope
  (c) At least in the case of Typed Template Haskell we should never get
      a type error from the splice.

We consult the module-wide RebindableSyntax flag here. We could instead record
the choice in ExpandedThingRn, but it seems simpler to consult the flag (again).
-}

-----------------------------------------------------------------------------
-- Building representations of auxiliary structures like Match, Clause, Stmt,

repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Match))
repMatchTup :: LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatchTup (L SrcSpanAnnA
_ (Match { m_pats :: forall p body. Match p body -> XRec p [LPat p]
m_pats = L EpaLocation
_ [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
p]
                        , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
_ NonEmpty
  (LGRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
guards HsLocalBinds (GhcPass 'Renamed)
wheres })) =
  do { ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms (CollectFlag (GhcPass 'Renamed)
-> LPat (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag (GhcPass 'Renamed)
forall p. CollectFlag p
CollNoDictBinders LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
p)
     ; addBinds ss1 $ do {
     ; p1 <- repLP p
     ; (ss2,ds) <- repBinds wheres
     ; addBinds ss2 $ do {
     ; gs    <- repGuards guards
     ; match <- repMatch p1 gs ds
     ; wrapGenSyms (ss1++ss2) match }}}
repMatchTup LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
_ = String -> ReaderT MetaWrappers DsM (Core (M Match))
forall a. HasCallStack => String -> a
panic String
"repMatchTup: case alt with more than one arg or with invisible pattern"

repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Clause))
repClauseTup :: LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClauseTup (L SrcSpanAnnA
_ (Match { m_pats :: forall p body. Match p body -> XRec p [LPat p]
m_pats = L EpaLocation
_ [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
ps
                         , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
_ NonEmpty
  (LGRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
guards  HsLocalBinds (GhcPass 'Renamed)
wheres })) =
  do { ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms (CollectFlag (GhcPass 'Renamed)
-> [LPat (GhcPass 'Renamed)] -> [IdP (GhcPass 'Renamed)]
forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag (GhcPass 'Renamed)
forall p. CollectFlag p
CollNoDictBinders [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
ps)
     ; addBinds ss1 $ do {
       ps1 <- repLPs ps
     ; (ss2,ds) <- repBinds wheres
     ; addBinds ss2 $ do {
       gs <- repGuards guards
     ; clause <- repClause ps1 gs ds
     ; wrapGenSyms (ss1++ss2) clause }}}

repGuards :: NonEmpty (LGRHS GhcRn (LHsExpr GhcRn)) ->  MetaM (Core (M TH.Body))
repGuards :: NonEmpty (LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed)))
-> MetaM (Core (M Body))
repGuards (L EpAnnCO
_ (GRHS XCGRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
_ [] GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e) :| [])
  = do {a <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e; repNormal a }
repGuards NonEmpty (LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed)))
other
  = do { zs <- (GenLocated
   EpAnnCO
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp))))
-> NonEmpty
     (GenLocated
        EpAnnCO
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> ReaderT
     MetaWrappers DsM (NonEmpty ([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) -> NonEmpty a -> m (NonEmpty b)
mapM LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
GenLocated
  EpAnnCO
  (GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
repLGRHS NonEmpty (LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed)))
NonEmpty
  (GenLocated
     EpAnnCO
     (GRHS
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
other
       ; let (xs, ys) = NE.unzip zs
       ; gd <- repGuarded (nonEmptyCoreList' ys)
       ; wrapGenSyms (concat xs) gd }

repLGRHS :: LGRHS GhcRn (LHsExpr GhcRn)
         -> MetaM ([GenSymBind], (Core (M (TH.Guard, TH.Exp))))
repLGRHS :: LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
repLGRHS (L EpAnnCO
_ (GRHS XCGRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
_ [L SrcSpanAnnA
_ (BodyStmt XBodyStmt
  (GhcPass 'Renamed)
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
_ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e1 SyntaxExpr (GhcPass 'Renamed)
_ SyntaxExpr (GhcPass 'Renamed)
_)] GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e2))
  = do { guarded <- LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M (Guard, Exp)))
repLNormalGE LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e1 LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e2
       ; return ([], guarded) }
repLGRHS (L EpAnnCO
_ (GRHS XCGRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
_ [ExprLStmt (GhcPass 'Renamed)]
ss GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
rhs))
  = do { (gs, ss') <- [ExprLStmt (GhcPass 'Renamed)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt (GhcPass 'Renamed)]
ss
       ; rhs' <- addBinds gs $ repLE rhs
       ; guarded <- repPatGE (nonEmptyCoreList ss') rhs'
       ; return (gs, guarded) }

repFields :: HsRecordBinds GhcRn -> MetaM (Core [M TH.FieldExp])
repFields :: HsRecordBinds (GhcPass 'Renamed) -> MetaM (Core [M FieldExp])
repFields (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)]
flds })
  = Name
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
    -> MetaM (Core (M FieldExp)))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> MetaM (Core [M FieldExp])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
fieldExpTyConName LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)
-> MetaM (Core (M FieldExp))
GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> MetaM (Core (M FieldExp))
rep_fld [LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
flds
  where
    rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn)
            -> MetaM (Core (M TH.FieldExp))
    rep_fld :: LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)
-> MetaM (Core (M FieldExp))
rep_fld (L SrcSpanAnnA
_ HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
fld) = do { fn <- Name -> MetaM (Core Name)
lookupOcc (HsRecField
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> IdGhcP 'Renamed
forall (p :: Pass) arg. HsRecField (GhcPass p) arg -> IdGhcP p
hsRecFieldSel HsRecField
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
fld)
                           ; e  <- repLE (hfbRHS fld)
                           ; repFieldExp fn e }

repUpdFields :: [LHsRecUpdField GhcRn GhcRn] -> MetaM (Core [M TH.FieldExp])
repUpdFields :: [LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)]
-> MetaM (Core [M FieldExp])
repUpdFields = Name
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
    -> MetaM (Core (M FieldExp)))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> MetaM (Core [M FieldExp])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
fieldExpTyConName LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)
-> MetaM (Core (M FieldExp))
GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> MetaM (Core (M FieldExp))
rep_fld
  where
    rep_fld :: LHsRecUpdField GhcRn GhcRn -> MetaM (Core (M TH.FieldExp))
    rep_fld :: LHsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)
-> MetaM (Core (M FieldExp))
rep_fld (L SrcSpanAnnA
l HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
fld) =
      let (FieldOcc XCFieldOcc (GhcPass 'Renamed)
_ (L SrcSpanAnnN
_ Name
sel_name)) = GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed))
-> FieldOcc (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc (HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed))
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
fld)
      -- If we have an unbountName in the sel_name, that means we failed to
      -- disambiguate during the Rename stage of Ghc. Now if we continued
      -- onwards to type checking that might be fine, as explained in
      -- Note [Ambiguous FieldOcc in record updates], but if instead we
      -- are within the context of Template Haskell, we just fail immediately.
      in if  Name -> Bool
isUnboundName Name
sel_name
       then  ThRejectionReason -> MetaM (Core (M FieldExp))
forall a. ThRejectionReason -> MetaM a
notHandled (HsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)
-> ThRejectionReason
ThAmbiguousRecordUpdates HsRecUpdField (GhcPass 'Renamed) (GhcPass 'Renamed)
HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
fld)
       else  do  { 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 Name
sel_name)
                 ; e  <- repLE (hfbRHS fld)
                 ; repFieldExp fn e
                 }



-----------------------------------------------------------------------------
-- Representing Stmt's is tricky, especially if bound variables
-- shadow each other. Consider:  [| do { x <- f 1; x <- f x; g x } |]
-- First gensym new names for every variable in any of the patterns.
-- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
-- if variables didn't shadow, the static gensym wouldn't be necessary
-- and we could reuse the original names (x and x).
--
-- do { x'1 <- gensym "x"
--    ; x'2 <- gensym "x"
--    ; doE Nothing
--          [ BindSt (pvar x'1) [| f 1 |]
--          , BindSt (pvar x'2) [| f x |]
--          , NoBindSt [| g x |]
--          ]
--    }

-- The strategy is to translate a whole list of do-bindings by building a
-- bigger environment, and a bigger set of meta bindings
-- (like:  x'1 <- gensym "x" ) and then combining these with the translations
-- of the expressions within the Do

-----------------------------------------------------------------------------
-- The helper function repSts computes the translation of each sub expression
-- and a bunch of prefix bindings denoting the dynamic renaming.

repLSts :: [LStmt GhcRn (LHsExpr GhcRn)] -> MetaM ([GenSymBind], [Core (M TH.Stmt)])
repLSts :: [ExprLStmt (GhcPass 'Renamed)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt (GhcPass 'Renamed)]
stmts = [Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts ((GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> [StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Renamed)
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> StmtLR
     (GhcPass 'Renamed)
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall l e. GenLocated l e -> e
unLoc [ExprLStmt (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmts)

repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> MetaM ([GenSymBind], [Core (M TH.Stmt)])
repSts :: [Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts (BindStmt XBindStmt
  (GhcPass 'Renamed) (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
_ LPat (GhcPass 'Renamed)
p LHsExpr (GhcPass 'Renamed)
e : [Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
ss) =
   do { e2 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e
      ; ss1 <- mkGenSyms (collectPatBinders CollNoDictBinders p)
      ; addBinds ss1 $ do {
      ; p1 <- repLP p;
      ; (ss2,zs) <- repSts ss
      ; z <- repBindSt p1 e2
      ; return (ss1++ss2, z : zs) }}
repSts (LetStmt XLetStmt
  (GhcPass 'Renamed) (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
_ HsLocalBinds (GhcPass 'Renamed)
bs : [Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
ss) =
   do { (ss1,ds) <- HsLocalBinds (GhcPass 'Renamed)
-> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds (GhcPass 'Renamed)
bs
      ; z <- repLetSt ds
      ; (ss2,zs) <- addBinds ss1 (repSts ss)
      ; return (ss1++ss2, z : zs) }
repSts (BodyStmt XBodyStmt
  (GhcPass 'Renamed) (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
_ LHsExpr (GhcPass 'Renamed)
e SyntaxExpr (GhcPass 'Renamed)
_ SyntaxExpr (GhcPass 'Renamed)
_ : [Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
ss) =
   do { e2 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e
      ; z <- repNoBindSt e2
      ; (ss2,zs) <- repSts ss
      ; return (ss2, z : zs) }
repSts (ParStmt XParStmt
  (GhcPass 'Renamed) (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
_ NonEmpty (ParStmtBlock (GhcPass 'Renamed) (GhcPass 'Renamed))
stmt_blocks HsExpr (GhcPass 'Renamed)
_ SyntaxExpr (GhcPass 'Renamed)
_ : [Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
ss) =
   do { (ss_s, stmt_blocks1) <- NonEmpty ([GenSymBind], Core [M Stmt])
-> (NonEmpty [GenSymBind], NonEmpty (Core [M Stmt]))
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip (NonEmpty ([GenSymBind], Core [M Stmt])
 -> (NonEmpty [GenSymBind], NonEmpty (Core [M Stmt])))
-> ReaderT
     MetaWrappers DsM (NonEmpty ([GenSymBind], Core [M Stmt]))
-> ReaderT
     MetaWrappers DsM (NonEmpty [GenSymBind], NonEmpty (Core [M Stmt]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParStmtBlock (GhcPass 'Renamed) (GhcPass 'Renamed)
 -> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt]))
-> NonEmpty (ParStmtBlock (GhcPass 'Renamed) (GhcPass 'Renamed))
-> ReaderT
     MetaWrappers DsM (NonEmpty ([GenSymBind], Core [M Stmt]))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse ParStmtBlock (GhcPass 'Renamed) (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt])
rep_stmt_block NonEmpty (ParStmtBlock (GhcPass 'Renamed) (GhcPass 'Renamed))
stmt_blocks
      ; let stmt_blocks2 = NonEmpty (Core [M Stmt]) -> Core [[M Stmt]]
forall a. NonEmpty (Core a) -> Core [a]
nonEmptyCoreList' NonEmpty (Core [M Stmt])
stmt_blocks1
            ss1 = NonEmpty [GenSymBind] -> [GenSymBind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat NonEmpty [GenSymBind]
ss_s
      ; z <- repParSt stmt_blocks2
      ; (ss2, zs) <- addBinds ss1 (repSts ss)
      ; return (ss1++ss2, z : zs) }
   where
     rep_stmt_block :: ParStmtBlock GhcRn GhcRn
                    -> MetaM ([GenSymBind], Core [(M TH.Stmt)])
     rep_stmt_block :: ParStmtBlock (GhcPass 'Renamed) (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt])
rep_stmt_block (ParStmtBlock XParStmtBlock (GhcPass 'Renamed) (GhcPass 'Renamed)
_ [ExprLStmt (GhcPass 'Renamed)]
stmts [IdP (GhcPass 'Renamed)]
_ SyntaxExpr (GhcPass 'Renamed)
_) =
       do { (ss1, zs) <- [Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts ((GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> [StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Renamed)
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> StmtLR
     (GhcPass 'Renamed)
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall l e. GenLocated l e -> e
unLoc [ExprLStmt (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmts)
          ; zs1 <- coreListM stmtTyConName zs
          ; return (ss1, zs1) }
repSts [LastStmt XLastStmt
  (GhcPass 'Renamed) (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
_ LHsExpr (GhcPass 'Renamed)
e Maybe Bool
_ SyntaxExpr (GhcPass 'Renamed)
_]
  = do { e2 <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e
       ; z <- repNoBindSt e2
       ; return ([], [z]) }
repSts (stmt :: Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
stmt@RecStmt{} : [Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
ss)
  = do { let binders :: [IdP (GhcPass 'Renamed)]
binders = CollectFlag (GhcPass 'Renamed)
-> [LStmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> [IdP (GhcPass 'Renamed)]
forall (idL :: Pass) (idR :: Pass) body.
(IsPass idL, IsPass idR, CollectPass (GhcPass idL)) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag (GhcPass 'Renamed)
forall p. CollectFlag p
CollNoDictBinders (GenLocated
  SrcSpanAnnLW
  [LStmtLR
     (GhcPass 'Renamed)
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> [LStmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
   SrcSpanAnnLW
   [LStmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
 -> [LStmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))])
-> GenLocated
     SrcSpanAnnLW
     [LStmtLR
        (GhcPass 'Renamed)
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> [LStmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall a b. (a -> b) -> a -> b
$ StmtLR
  (GhcPass 'Renamed)
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> XRec
     (GhcPass 'Renamed)
     [LStmtLR
        (GhcPass 'Renamed)
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
StmtLR
  (GhcPass 'Renamed)
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
stmt)
       ; ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms [IdP (GhcPass 'Renamed)]
[Name]
binders
       -- Bring all of binders in the recursive group into scope for the
       -- whole group.
       ; (ss1_other,rss) <- addBinds ss1 $ repSts (map unLoc (unLoc $ recS_stmts stmt))
       ; massert (sort ss1 == sort ss1_other)
       ; z <- repRecSt (nonEmptyCoreList rss)
       ; (ss2,zs) <- addBinds ss1 (repSts ss)
       ; return (ss1++ss2, z : 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 (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
other = ThRejectionReason -> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. ThRejectionReason -> MetaM a
notHandled ([Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
-> ThRejectionReason
ThExoticStatement [Stmt (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
other)


-----------------------------------------------------------
--                      Bindings
-----------------------------------------------------------

repBinds :: HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [(M TH.Dec)])
repBinds :: HsLocalBinds (GhcPass 'Renamed)
-> MetaM ([GenSymBind], Core [M Dec])
repBinds (EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
_)
  = do  { core_list <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName []
        ; return ([], core_list) }

repBinds (HsIPBinds XHsIPBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
_ (IPBinds XIPBinds (GhcPass 'Renamed)
_ [LIPBind (GhcPass 'Renamed)]
decs))
 = do   { ips <- (GenLocated SrcSpanAnnA (IPBind (GhcPass 'Renamed))
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated SrcSpanAnnA (IPBind (GhcPass 'Renamed))]
-> 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 (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated SrcSpanAnnA (IPBind (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_implicit_param_bind [LIPBind (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (IPBind (GhcPass 'Renamed))]
decs
        ; core_list <- coreListM decTyConName
                                (de_loc (sort_by_loc ips))
        ; return ([], core_list)
        }

repBinds (HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
_ HsValBinds (GhcPass 'Renamed)
decs)
 = do   { let { bndrs :: [Name]
bndrs = HsValBinds (GhcPass 'Renamed) -> [Name]
hsScopedTvBinders HsValBinds (GhcPass 'Renamed)
decs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ CollectFlag (GhcPass 'Renamed)
-> HsValBinds (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (idL :: Pass) idR.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR -> [IdP (GhcPass idL)]
collectHsValBinders CollectFlag (GhcPass 'Renamed)
forall p. CollectFlag p
CollNoDictBinders HsValBinds (GhcPass 'Renamed)
decs }
                -- No need to worry about detailed scopes within
                -- the binding group, because we are talking Names
                -- here, so we can safely treat it as a mutually
                -- recursive group
                -- For hsScopedTvBinders see Note [Scoped type variables in quotes]
        ; ss        <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
bndrs
        ; prs       <- addBinds ss (rep_val_binds decs)
        ; core_list <- coreListM decTyConName
                                (de_loc (sort_by_loc prs))
        ; return (ss, core_list) }

rep_implicit_param_bind :: LIPBind GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
rep_implicit_param_bind :: LIPBind (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_implicit_param_bind (L SrcSpanAnnA
loc (IPBind XCIPBind (GhcPass 'Renamed)
_ (L EpAnnCO
_ HsIPName
n) (L SrcSpanAnnA
_ HsExpr (GhcPass 'Renamed)
rhs)))
 = do { name <- HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name HsIPName
n
      ; rhs' <- repE rhs
      ; ipb <- repImplicitParamBind name rhs'
      ; return (locA loc, 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))]
-- Assumes: all the binders of the binding are already in the meta-env
rep_val_binds :: HsValBinds (GhcPass 'Renamed) -> MetaM [(SrcSpan, Core (M Dec))]
rep_val_binds (XValBindsLR (NValBinds [(RecFlag, LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
binds [LSig (GhcPass 'Renamed)]
sigs))
 = do { core1 <- LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> MetaM [(SrcSpan, Core (M Dec))]
rep_binds (((RecFlag,
  [GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
 -> [GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
-> [(RecFlag,
     [GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])]
-> [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RecFlag,
 [GenLocated
    SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])
-> [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall a b. (a, b) -> b
snd [(RecFlag, LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
[(RecFlag,
  [GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))])]
binds)
      ; core2 <- rep_sigs sigs
      ; return (core1 ++ core2) }
rep_val_binds (ValBinds XValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
_ LHsBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
_ [LSig (GhcPass 'Renamed)]
_)
 = 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 (GhcPass 'Renamed) (GhcPass 'Renamed)
-> MetaM [(SrcSpan, Core (M Dec))]
rep_binds = (GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> 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 (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_bind

rep_bind :: LHsBind GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
-- Assumes: all the binders of the binding are already in the meta-env

-- Note GHC treats declarations of a variable (not a pattern)
-- e.g.  x = g 5 as a Fun MonoBinds. This is indicated by a single match
-- with an empty list of patterns
rep_bind :: LHsBind (GhcPass 'Renamed)
-> 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 (GhcPass 'Renamed)
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 SrcSpanAnnLW
_ [L SrcSpanAnnA
_ (Match
                                   { m_pats :: forall p body. Match p body -> XRec p [LPat p]
m_pats = L EpaLocation
_ []
                                   , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
_ NonEmpty
  (LGRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
guards HsLocalBinds (GhcPass 'Renamed)
wheres
                                   -- For a variable declaration I'm pretty
                                   -- sure we always have a FunRhs
                                   , m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
m_ctxt = FunRhs { mc_strictness :: forall fn. HsMatchContext fn -> SrcStrictness
mc_strictness = SrcStrictness
strictessAnn }
                                   } )]) } }))
 = do { (ss,wherecore) <- HsLocalBinds (GhcPass 'Renamed)
-> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds (GhcPass 'Renamed)
wheres
        ; guardcore <- addBinds ss (repGuards guards)
        ; fn'  <- lookupNBinder fn
        ; p    <- repPvar fn' >>= case strictessAnn of
                                    SrcStrictness
SrcLazy -> Core (M Pat) -> MetaM (Core (M Pat))
repPtilde
                                    SrcStrictness
SrcStrict -> Core (M Pat) -> MetaM (Core (M Pat))
repPbang
                                    SrcStrictness
NoSrcStrict -> Core (M Pat) -> MetaM (Core (M Pat))
forall a. a -> ReaderT MetaWrappers DsM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ; ans  <- repVal p guardcore wherecore
        ; ans' <- wrapGenSyms ss ans
        ; return (locA loc, ans') }

rep_bind (L SrcSpanAnnA
loc (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = LIdP (GhcPass 'Renamed)
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 SrcSpanAnnLW
_ [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
ms } }))
 =   do { ms1 <- (GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> ReaderT MetaWrappers DsM (Core (M Clause)))
-> [GenLocated
      SrcSpanAnnA
      (Match
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> 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 (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (Core (M Clause))
GenLocated
  SrcSpanAnnA
  (Match
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClauseTup [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
ms
        ; fn' <- lookupNBinder fn
        ; ans <- repFun fn' (nonEmptyCoreList ms1)
        ; return (locA loc, ans) }

rep_bind (L SrcSpanAnnA
loc (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat (GhcPass 'Renamed)
pat
                         , pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs = GRHSs XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
_ NonEmpty (LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed)))
guards HsLocalBinds (GhcPass 'Renamed)
wheres }))
 =   do { patcore <- LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repLP LPat (GhcPass 'Renamed)
pat
        ; (ss,wherecore) <- repBinds wheres
        ; guardcore <- addBinds ss (repGuards guards)
        ; ans  <- repVal patcore guardcore wherecore
        ; ans' <- wrapGenSyms ss ans
        ; return (locA loc, ans') }

rep_bind (L SrcSpanAnnA
loc (PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
_ (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id   = LIdP (GhcPass 'Renamed)
syn
                                   , psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_args = HsPatSynDetails (GhcPass 'Renamed)
args
                                   , psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def  = LPat (GhcPass 'Renamed)
pat
                                   , psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir  = HsPatSynDir (GhcPass 'Renamed)
dir })))
  = do { syn'      <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
syn
       ; dir'      <- repPatSynDir dir
       ; ss        <- mkGenArgSyms args
       ; patSynD'  <- addBinds ss (
         do { args'  <- repPatSynArgs args
            ; pat'   <- repLP pat
            ; repPatSynD syn' args' dir' pat' })
       ; patSynD'' <- wrapGenArgSyms args ss patSynD'
       ; return (locA loc, patSynD'') }
  where
    mkGenArgSyms :: HsPatSynDetails GhcRn -> MetaM [GenSymBind]
    -- for Record Pattern Synonyms we want to conflate the selector
    -- and the pattern-only names in order to provide a nicer TH
    -- API. Whereas inside GHC, record pattern synonym selectors and
    -- their pattern-only bound right hand sides have different names,
    -- we want to treat them the same in TH. This is the reason why we
    -- need an adjusted mkGenArgSyms in the `RecCon` case below.
    mkGenArgSyms :: HsPatSynDetails (GhcPass 'Renamed) -> MetaM [GenSymBind]
mkGenArgSyms (PrefixCon [LIdP (GhcPass 'Renamed)]
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 (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
args)
    mkGenArgSyms (InfixCon LIdP (GhcPass 'Renamed)
arg1 LIdP (GhcPass 'Renamed)
arg2) = [Name] -> MetaM [GenSymBind]
mkGenSyms [GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
arg1, GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
arg2]
    mkGenArgSyms (RecCon [RecordPatSynField (GhcPass 'Renamed)]
fields)
      = do { let pats :: [Name]
pats = (RecordPatSynField (GhcPass 'Renamed) -> Name)
-> [RecordPatSynField (GhcPass 'Renamed)] -> [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 (GhcPass 'Renamed)
    -> GenLocated SrcSpanAnnN Name)
-> RecordPatSynField (GhcPass 'Renamed)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (GhcPass 'Renamed) -> LIdP (GhcPass 'Renamed)
RecordPatSynField (GhcPass 'Renamed) -> GenLocated SrcSpanAnnN Name
forall pass. RecordPatSynField pass -> LIdP pass
recordPatSynPatVar) [RecordPatSynField (GhcPass 'Renamed)]
fields
                 sels :: [Name]
sels = (RecordPatSynField (GhcPass 'Renamed) -> Name)
-> [RecordPatSynField (GhcPass 'Renamed)] -> [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 (GhcPass 'Renamed)
    -> GenLocated SrcSpanAnnN Name)
-> RecordPatSynField (GhcPass 'Renamed)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc (GhcPass 'Renamed) -> LIdP (GhcPass 'Renamed)
FieldOcc (GhcPass 'Renamed) -> GenLocated SrcSpanAnnN Name
forall pass. FieldOcc pass -> LIdP pass
foLabel (FieldOcc (GhcPass 'Renamed) -> GenLocated SrcSpanAnnN Name)
-> (RecordPatSynField (GhcPass 'Renamed)
    -> FieldOcc (GhcPass 'Renamed))
-> RecordPatSynField (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnN Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (GhcPass 'Renamed) -> FieldOcc (GhcPass 'Renamed)
forall pass. RecordPatSynField pass -> FieldOcc pass
recordPatSynField) [RecordPatSynField (GhcPass 'Renamed)]
fields
           ; ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
sels
           ; return $ replaceNames (zip sels pats) 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 (GhcPass 'Renamed)
-> [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
wrapGenArgSyms (RecCon [RecordPatSynField (GhcPass 'Renamed)]
_) [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 (GhcPass 'Renamed)
_          [GenSymBind]
ss Core (M Dec)
dec = [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall {k} (a :: k).
[GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
dec

rep_bind (L SrcSpanAnnA
_ (VarBind { var_ext :: forall idL idR. HsBindLR idL idR -> XVarBind idL idR
var_ext = XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
x })) = DataConCantHappen
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. DataConCantHappen -> a
dataConCantHappen XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
DataConCantHappen
x

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 {k} (a :: k). 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 (GhcPass 'Renamed) -> MetaM (Core (M PatSynArgs))
repPatSynArgs (PrefixCon [LIdP (GhcPass 'Renamed)]
args)
  = do { 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 (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
args
       ; repPrefixPatSynArgs args' }
repPatSynArgs (InfixCon LIdP (GhcPass 'Renamed)
arg1 LIdP (GhcPass 'Renamed)
arg2)
  = do { arg1' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
arg1
       ; arg2' <- lookupLOcc arg2
       ; repInfixPatSynArgs arg1' arg2' }
repPatSynArgs (RecCon [RecordPatSynField (GhcPass 'Renamed)]
fields)
  = do { sels' <- Name
-> (FieldOcc (GhcPass 'Renamed) -> MetaM (Core Name))
-> [FieldOcc (GhcPass 'Renamed)]
-> 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 (GhcPass 'Renamed) -> Name)
-> FieldOcc (GhcPass 'Renamed)
-> 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 (GenLocated SrcSpanAnnN Name -> Name)
-> (FieldOcc (GhcPass 'Renamed) -> GenLocated SrcSpanAnnN Name)
-> FieldOcc (GhcPass 'Renamed)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc (GhcPass 'Renamed) -> LIdP (GhcPass 'Renamed)
FieldOcc (GhcPass 'Renamed) -> GenLocated SrcSpanAnnN Name
forall pass. FieldOcc pass -> LIdP pass
foLabel) [FieldOcc (GhcPass 'Renamed)]
sels
       ; repRecordPatSynArgs sels' }
  where sels :: [FieldOcc (GhcPass 'Renamed)]
sels = (RecordPatSynField (GhcPass 'Renamed)
 -> FieldOcc (GhcPass 'Renamed))
-> [RecordPatSynField (GhcPass 'Renamed)]
-> [FieldOcc (GhcPass 'Renamed)]
forall a b. (a -> b) -> [a] -> [b]
map RecordPatSynField (GhcPass 'Renamed) -> FieldOcc (GhcPass 'Renamed)
forall pass. RecordPatSynField pass -> FieldOcc pass
recordPatSynField [RecordPatSynField (GhcPass 'Renamed)]
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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recordPatSynName [CoreExpr
sels]

repPatSynDir :: HsPatSynDir GhcRn -> MetaM (Core (M TH.PatSynDir))
repPatSynDir :: HsPatSynDir (GhcPass 'Renamed) -> MetaM (Core (M PatSynDir))
repPatSynDir HsPatSynDir (GhcPass 'Renamed)
Unidirectional        = Name -> [CoreExpr] -> MetaM (Core (M PatSynDir))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unidirPatSynName []
repPatSynDir HsPatSynDir (GhcPass 'Renamed)
ImplicitBidirectional = Name -> [CoreExpr] -> MetaM (Core (M PatSynDir))
forall {k} (a :: k). 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 SrcSpanAnnLW
_ [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
clauses) }))
  = do { clauses' <- (GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> ReaderT MetaWrappers DsM (Core (M Clause)))
-> [GenLocated
      SrcSpanAnnA
      (Match
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> 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 (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (Core (M Clause))
GenLocated
  SrcSpanAnnA
  (Match
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> ReaderT MetaWrappers DsM (Core (M Clause))
repClauseTup [GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
clauses
       ; repExplBidirPatSynDir (nonEmptyCoreList 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
explBidirPatSynName [CoreExpr
cls]


-----------------------------------------------------------------------------
-- Since everything in a Bind is mutually recursive we need rename all
-- all the variables simultaneously. For example:
-- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
-- do { f'1 <- gensym "f"
--    ; g'2 <- gensym "g"
--    ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
--        do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
--      ]}
-- This requires collecting the bindings (f'1 <- gensym "f"), and the
-- environment ( f |-> f'1 ) from each binding, and then unioning them
-- together. As we do this we collect GenSymBinds's which represent the renamed
-- variables bound by the Bindings. In order not to lose track of these
-- representations we build a shadow datatype MB with the same structure as
-- MonoBinds, but which has slots for the representations


-----------------------------------------------------------------------------
-- GHC allows a more general form of lambda abstraction than specified
-- by Haskell 98. In particular it allows guarded lambda's like :
-- (\  x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
-- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
-- (\ p1 .. pn -> exp) by causing an error.

repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Exp))
repLambda :: LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> MetaM (Core (M Exp))
repLambda (L SrcSpanAnnA
_ (Match { m_pats :: forall p body. Match p body -> XRec p [LPat p]
m_pats = L EpaLocation
_ [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
ps
                      , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
_ (L EpAnnCO
_ (GRHS XCGRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
_ [] GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e) :| [])
                                              (EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
_) } ))
 = do { let bndrs :: [IdP (GhcPass 'Renamed)]
bndrs = CollectFlag (GhcPass 'Renamed)
-> [LPat (GhcPass 'Renamed)] -> [IdP (GhcPass 'Renamed)]
forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag (GhcPass 'Renamed)
forall p. CollectFlag p
CollNoDictBinders [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
ps ;
      ; ss  <- [Name] -> MetaM [GenSymBind]
mkGenSyms [IdP (GhcPass 'Renamed)]
[Name]
bndrs
      ; lam <- addBinds ss (
                do { xs <- repLPs ps; body <- repLE e; repLam xs body })
      ; wrapGenSyms ss lam }

repLambda (L SrcSpanAnnA
_ Match
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
m) = ThRejectionReason -> MetaM (Core (M Exp))
forall a. ThRejectionReason -> MetaM a
notHandled (Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> ThRejectionReason
ThGuardedLambdas Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
Match
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
m)


-----------------------------------------------------------------------------
--                      Patterns
-- repP deals with patterns.  It assumes that we have already
-- walked over the pattern(s) once to collect the binders, and
-- have extended the environment.  So every pattern-bound
-- variable should already appear in the environment.

-- Process a list of patterns
repLPs :: [LPat GhcRn] -> MetaM (Core [(M TH.Pat)])
repLPs :: [LPat (GhcPass 'Renamed)] -> MetaM (Core [M Pat])
repLPs [LPat (GhcPass 'Renamed)]
ps = Name
-> (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
    -> MetaM (Core (M Pat)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> MetaM (Core [M Pat])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
patTyConName LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> MetaM (Core (M Pat))
repLP [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
ps

repLPs1 :: NonEmpty (LPat GhcRn) -> MetaM (Core (NonEmpty (M TH.Pat)))
repLPs1 :: NonEmpty (LPat (GhcPass 'Renamed))
-> MetaM (Core (NonEmpty (M Pat)))
repLPs1 NonEmpty (LPat (GhcPass 'Renamed))
ps = Name
-> (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
    -> MetaM (Core (M Pat)))
-> NonEmpty (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> MetaM (Core (NonEmpty (M Pat)))
forall a b.
Name
-> (a -> MetaM (Core b)) -> NonEmpty a -> MetaM (Core (NonEmpty b))
repNonEmptyM Name
patTyConName LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> MetaM (Core (M Pat))
repLP NonEmpty (LPat (GhcPass 'Renamed))
NonEmpty (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
ps

repLP :: LPat GhcRn -> MetaM (Core (M TH.Pat))
repLP :: LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repLP LPat (GhcPass 'Renamed)
p = Pat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repP (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> Pat (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
p)

repP :: Pat GhcRn -> MetaM (Core (M TH.Pat))
repP :: Pat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repP (WildPat XWildPat (GhcPass 'Renamed)
_)        = MetaM (Core (M Pat))
repPwild
repP (LitPat XLitPat (GhcPass 'Renamed)
_ HsLit (GhcPass 'Renamed)
l)       = do { l2 <- HsLit (GhcPass 'Renamed) -> MetaM (Core Lit)
repLiteral HsLit (GhcPass 'Renamed)
l; repPlit l2 }
repP (VarPat XVarPat (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
x)       = do { x' <- Name -> MetaM (Core Name)
lookupBinder (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
x); repPvar x' }
repP (LazyPat XLazyPat (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
p)      = do { p1 <- LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repLP LPat (GhcPass 'Renamed)
p; repPtilde p1 }
repP (BangPat XBangPat (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
p)      = do { p1 <- LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repLP LPat (GhcPass 'Renamed)
p; repPbang p1 }
repP (AsPat XAsPat (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
x LPat (GhcPass 'Renamed)
p)      = do { x' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
lookupNBinder LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
x; p1 <- repLP p
                             ; repPaspat x' p1 }
repP (ParPat XParPat (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
p)       = LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repLP LPat (GhcPass 'Renamed)
p
repP (ListPat XListPat (GhcPass 'Renamed)
_ [LPat (GhcPass 'Renamed)]
ps)     = do { qs <- [LPat (GhcPass 'Renamed)] -> MetaM (Core [M Pat])
repLPs [LPat (GhcPass 'Renamed)]
ps; repPlist qs }
repP (TuplePat XTuplePat (GhcPass 'Renamed)
_ [LPat (GhcPass 'Renamed)]
ps Boxity
boxed)
  | Boxity -> Bool
isBoxed Boxity
boxed       = do { qs <- [LPat (GhcPass 'Renamed)] -> MetaM (Core [M Pat])
repLPs [LPat (GhcPass 'Renamed)]
ps; repPtup qs }
  | Bool
otherwise           = do { qs <- [LPat (GhcPass 'Renamed)] -> MetaM (Core [M Pat])
repLPs [LPat (GhcPass 'Renamed)]
ps; repPunboxedTup qs }
repP (SumPat XSumPat (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
p Int
alt Int
arity) = do { p1 <- LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repLP LPat (GhcPass 'Renamed)
p
                                 ; repPunboxedSum p1 alt arity }
repP (ConPat XConPat (GhcPass 'Renamed)
NoExtField
NoExtField XRec (GhcPass 'Renamed) (ConLikeP (GhcPass 'Renamed))
dc HsConPatDetails (GhcPass 'Renamed)
details)
 = do { con_str <- GenLocated SrcSpanAnnN (WithUserRdr Name) -> MetaM (Core Name)
forall l. GenLocated l (WithUserRdr Name) -> MetaM (Core Name)
lookupWithUserRdrLOcc XRec (GhcPass 'Renamed) (ConLikeP (GhcPass 'Renamed))
GenLocated SrcSpanAnnN (WithUserRdr Name)
dc
      ; case details of
         PrefixCon [LPat (GhcPass 'Renamed)]
ps -> do { ts' <- Name
-> (HsTyPat (GhcPass 'Renamed) -> MetaM (Core (M Type)))
-> [HsTyPat (GhcPass 'Renamed)]
-> MetaM (Core [M Type])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
typeTyConName (HsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repTy (HsType (GhcPass 'Renamed) -> MetaM (Core (M Type)))
-> (HsTyPat (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed))
-> HsTyPat (GhcPass 'Renamed)
-> MetaM (Core (M Type))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
-> HsType (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
 -> HsType (GhcPass 'Renamed))
-> (HsTyPat (GhcPass 'Renamed)
    -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
-> HsTyPat (GhcPass 'Renamed)
-> HsType (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTyPat (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
HsTyPat (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
forall pass. HsTyPat pass -> LHsType pass
hstp_body) ([LPat (GhcPass 'Renamed)] -> [HsTyPat (NoGhcTc (GhcPass 'Renamed))]
forall p. UnXRec p => [LPat p] -> [HsTyPat (NoGhcTc p)]
takeHsConPatTyArgs [LPat (GhcPass 'Renamed)]
ps)
                            ; ps' <- repLPs (dropHsConPatTyArgs ps)
                            ; repPcon con_str ts' ps' }
         RecCon HsRecFields (GhcPass 'Renamed) (LPat (GhcPass 'Renamed))
rec   -> do { fps <- Name
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
    -> MetaM (Core (M (Name, Pat))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))]
-> MetaM (Core [M (Name, Pat)])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
fieldPatTyConName LHsRecField (GhcPass 'Renamed) (LPat (GhcPass 'Renamed))
-> MetaM (Core (M (Name, Pat)))
GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> MetaM (Core (M (Name, Pat)))
rep_fld (HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> [LHsRecField
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields (GhcPass 'Renamed) (LPat (GhcPass 'Renamed))
HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
rec)
                            ; repPrec con_str fps }
         InfixCon LPat (GhcPass 'Renamed)
p1 LPat (GhcPass 'Renamed)
p2 -> do { p1' <- LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repLP LPat (GhcPass 'Renamed)
p1;
                                p2' <- repLP p2;
                                repPinfix p1' con_str p2' }
   }
 where
   rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (TH.Name, TH.Pat)))
   rep_fld :: LHsRecField (GhcPass 'Renamed) (LPat (GhcPass 'Renamed))
-> MetaM (Core (M (Name, Pat)))
rep_fld (L SrcSpanAnnA
_ HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
fld) = do { MkC v <- Name -> MetaM (Core Name)
lookupOcc (HsRecField
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> IdGhcP 'Renamed
forall (p :: Pass) arg. HsRecField (GhcPass p) arg -> IdGhcP p
hsRecFieldSel HsRecField
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
HsFieldBind
  (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
fld)
                          ; MkC p <- repLP (hfbRHS fld)
                          ; rep2 fieldPatName [v,p] }
repP (NPat XNPat (GhcPass 'Renamed)
_ (L EpAnnCO
_ HsOverLit (GhcPass 'Renamed)
l) Maybe (SyntaxExpr (GhcPass 'Renamed))
Nothing SyntaxExpr (GhcPass 'Renamed)
_) = do { a <- HsOverLit (GhcPass 'Renamed) -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit (GhcPass 'Renamed)
l
                                     ; repPlit a }
repP (ViewPat XViewPat (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
e LPat (GhcPass 'Renamed)
p) = do { e' <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
e; p' <- repLP p; repPview e' p' }
repP p :: Pat (GhcPass 'Renamed)
p@(NPat XNPat (GhcPass 'Renamed)
_ (L EpAnnCO
_ HsOverLit (GhcPass 'Renamed)
l) (Just SyntaxExpr (GhcPass 'Renamed)
_) SyntaxExpr (GhcPass 'Renamed)
_)
  | OverLitRn Bool
rebindable LIdP (GhcPass 'Renamed)
_ <- HsOverLit (GhcPass 'Renamed) -> XOverLit (GhcPass 'Renamed)
forall p. HsOverLit p -> XOverLit p
ol_ext HsOverLit (GhcPass 'Renamed)
l
  , Bool
rebindable = ThRejectionReason -> MetaM (Core (M Pat))
forall a. ThRejectionReason -> MetaM a
notHandled (Pat (GhcPass 'Renamed) -> ThRejectionReason
ThNegativeOverloadedPatterns Pat (GhcPass 'Renamed)
p)
  | HsIntegral IntegralLit
i <- HsOverLit (GhcPass 'Renamed) -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit (GhcPass 'Renamed)
l = do { a <- HsOverLit (GhcPass 'Renamed) -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit (GhcPass 'Renamed)
l{ol_val = HsIntegral (negateIntegralLit i)}
                                  ; repPlit a }
  | HsFractional FractionalLit
i <- HsOverLit (GhcPass 'Renamed) -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit (GhcPass 'Renamed)
l = do { a <- HsOverLit (GhcPass 'Renamed) -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit (GhcPass 'Renamed)
l{ol_val = HsFractional (negateFractionalLit i)}
                                  ; repPlit a }
  | Bool
otherwise = ThRejectionReason -> MetaM (Core (M Pat))
forall a. ThRejectionReason -> MetaM a
notHandled (Pat (GhcPass 'Renamed) -> ThRejectionReason
ThExoticPattern Pat (GhcPass 'Renamed)
p)
repP (SigPat XSigPat (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
p HsPatSigType (NoGhcTc (GhcPass 'Renamed))
t) = do { p' <- LPat (GhcPass 'Renamed) -> MetaM (Core (M Pat))
repLP LPat (GhcPass 'Renamed)
p
                         ; t' <- repLTy (hsPatSigType t)
                         ; repPsig p' t' }
repP (EmbTyPat XEmbTyPat (GhcPass 'Renamed)
_ HsTyPat (NoGhcTc (GhcPass 'Renamed))
t) = do { t' <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy (HsTyPat (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall pass. HsTyPat pass -> LHsType pass
hstp_body HsTyPat (NoGhcTc (GhcPass 'Renamed))
HsTyPat (GhcPass 'Renamed)
t)
                         ; repPtype t' }
repP (InvisPat XInvisPat (GhcPass 'Renamed)
_ HsTyPat (NoGhcTc (GhcPass 'Renamed))
t) = do { t' <- LHsType (GhcPass 'Renamed) -> MetaM (Core (M Type))
repLTy (HsTyPat (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall pass. HsTyPat pass -> LHsType pass
hstp_body HsTyPat (NoGhcTc (GhcPass 'Renamed))
HsTyPat (GhcPass 'Renamed)
t)
                         ; repPinvis t' }
repP (OrPat XOrPat (GhcPass 'Renamed)
_ NonEmpty (LPat (GhcPass 'Renamed))
ps) = do { ps' <- NonEmpty (LPat (GhcPass 'Renamed))
-> MetaM (Core (NonEmpty (M Pat)))
repLPs1 NonEmpty (LPat (GhcPass 'Renamed))
ps; repPor ps' }
repP (SplicePat (HsUntypedSpliceNested Name
n) HsUntypedSplice (GhcPass 'Renamed)
_) = Name -> MetaM (Core (M Pat))
forall {k} (a :: k). Name -> MetaM (Core a)
rep_splice Name
n
repP p :: Pat (GhcPass 'Renamed)
p@(SplicePat (HsUntypedSpliceTop ThModFinalizers
_ Pat (GhcPass 'Renamed)
_) HsUntypedSplice (GhcPass 'Renamed)
_) = String -> SDoc -> MetaM (Core (M Pat))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repP: top level splice" (Pat (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat (GhcPass 'Renamed)
p)
repP Pat (GhcPass 'Renamed)
other = ThRejectionReason -> MetaM (Core (M Pat))
forall a. ThRejectionReason -> MetaM a
notHandled (Pat (GhcPass 'Renamed) -> ThRejectionReason
ThExoticPattern Pat (GhcPass 'Renamed)
other)

----------------------------------------------------------
-- Declaration ordering helpers

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

----------------------------------------------------------
--      The meta-environment

-- A name/identifier association for fresh names of locally bound entities
type GenSymBind = (Name, Id)    -- Gensym the string and bind it to the Id
                                -- I.e.         (x, x_id) means
                                --      let x_id = gensym "x" in ...

-- Generate a fresh name for a locally bound entity

mkGenSyms :: [Name] -> MetaM [GenSymBind]
-- We can use the existing name.  For example:
--      [| \x_77 -> x_77 + x_77 |]
-- desugars to
--      do { x_77 <- genSym "x"; .... }
-- We use the same x_77 in the desugared program, but with the type Bndr
-- instead of Int
--
-- We do make it an Internal name, though (hence localiseName)
--
-- Nevertheless, it's monadic because we have to generate nameTy
mkGenSyms :: [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
ns = do { var_ty <- Name -> MetaM Type
lookupType Name
nameTyConName
                  ; return [ (nm, mkLocalId (localiseName nm) ManyTy var_ty)
                           | nm <- ns] }


addBinds :: [GenSymBind] -> MetaM a -> MetaM a
-- Add a list of fresh names for locally bound entities to the
-- meta environment (which is part of the state carried around
-- by the desugarer monad)
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

-- Look up a locally bound name
--
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
  -- Binders are brought into scope before the pattern or what-not is
  -- desugared.  Moreover, in instance declaration the binder of a method
  -- will be the selector Id and hence a global; so we need the
  -- globalVar case of lookupOcc

-- Look up a name that is either locally bound or a global name
--
--  * If it is a global name, generate the "original name" representation (ie,
--   the <module>:<name> form) for the associated entity
--
lookupLOcc :: GenLocated l Name -> MetaM (Core TH.Name)
-- Lookup an occurrence; it can't be a splice.
-- Use the in-scope bindings if they exist
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)

lookupWithUserRdrLOcc :: GenLocated l (WithUserRdr Name) -> MetaM (Core TH.Name)
lookupWithUserRdrLOcc :: forall l. GenLocated l (WithUserRdr Name) -> MetaM (Core Name)
lookupWithUserRdrLOcc (L l
_loc (WithUserRdr RdrName
_rdr Name
n)) = Name -> MetaM (Core Name)
lookupOcc 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 {  mb_val <- Name -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
dsLookupMetaEnv Name
n ;
          case 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)
    }


-- Not bound by the meta-env
-- Could be top-level; or could be local
--      f x = $(g [| x |])
-- Here the x will be local
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 occ <- OccName -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
forall (m :: * -> *). MonadThings m => OccName -> m (Core String)
occNameLit OccName
name
        ; platform <- targetPlatform <$> getDynFlags
        ; let uni = Platform -> Integer -> CoreExpr
mkIntegerExpr Platform
platform (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ Unique -> Word64
getKey Unique
unique)
        ; rep2_nwDsM mkNameLName [occ,uni] }

globalVarExternal :: Module -> OccName -> DsM (Core TH.Name)
globalVarExternal :: Module -> OccName -> DsM (Core Name)
globalVarExternal Module
mod OccName
name_occ
  = do  { MkC mod <- FastString -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
name_mod
        ; MkC pkg <- coreStringLit name_pkg
        ; MkC occ <- occNameLit name_occ
        ; if | isDataOcc name_occ
             -> rep2_nwDsM mkNameG_dName [pkg,mod,occ]
             | isVarOcc  name_occ
             -> rep2_nwDsM mkNameG_vName [pkg,mod,occ]
             | isTcOcc   name_occ
             -> rep2_nwDsM mkNameG_tcName [pkg,mod,occ]
             | Just con_fs <- fieldOcc_maybe name_occ
             -> do { MkC con <- coreStringLit con_fs
                   ; rep2_nwDsM mkNameG_fldName [pkg,mod,con,occ] }
             | otherwise
             -> pprPanic "GHC.HsToCore.Quote.globalVar" (ppr name_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)

lookupType :: Name      -- Name of type constructor (e.g. (M TH.Exp))
           -> MetaM Type  -- The type
lookupType :: Name -> MetaM Type
lookupType Name
tc_name = do { 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 ;
                          return (mkTyConApp tc []) }

wrapGenSyms :: [GenSymBind]
            -> Core (M a) -> MetaM (Core (M a))
-- wrapGenSyms [(nm1,id1), (nm2,id2)] y
--      --> bindQ (gensym nm1) (\ id1 ->
--          bindQ (gensym nm2 (\ id2 ->
--          y))

wrapGenSyms :: forall {k} (a :: k).
[GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
binds body :: Core (M a)
body@(MkC CoreExpr
b)
  = do  { var_ty <- Name -> MetaM Type
lookupType Name
nameTyConName
        ; go var_ty binds }
  where
    (Type
_, Type
elt_ty) = Type -> (Type, Type)
tcSplitAppTy (HasDebugCallStack => CoreExpr -> Type
CoreExpr -> Type
exprType CoreExpr
b)
        -- b :: m a, so we can get the type 'a' by looking at the
        -- argument type. Need to use `tcSplitAppTy` here as since
        -- the overloaded quotations patch the type of the expression can
        -- be something more complicated than just `Q a`.
        -- See #17839 for when this went wrong with the type `WriterT () m a`

    go :: Type -> [GenSymBind] -> ReaderT MetaWrappers DsM (Core (M a))
go Type
_ [] = Core (M a) -> ReaderT MetaWrappers DsM (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 body'  <- Type -> [GenSymBind] -> ReaderT MetaWrappers DsM (Core (M a))
go Type
var_ty [GenSymBind]
binds
           ; lit_str    <- occNameLit (occName name)
           ; gensym_app <- repGensym lit_str
           ; repBindM var_ty elt_ty
                      gensym_app (MkC (Lam id 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)


-- %*********************************************************************
-- %*                                                                   *
--              Constructing code
-- %*                                                                   *
-- %*********************************************************************

-----------------------------------------------------------------------------
-- PHANTOM TYPES for consistency. In order to make sure we do this correct
-- we invent a new datatype which uses phantom types.

newtype Core a = MkC CoreExpr
unC :: Core a -> CoreExpr
unC :: forall {k} (a :: k). 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 {k} (a :: k). 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 {k} (m :: * -> *) (a :: k).
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 {k} (a :: k). 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 {k} (m :: * -> *) (a :: k).
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)
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr -> CoreExpr)
-> Name
-> [CoreExpr]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core a)
forall {k} (m :: * -> *) (a :: k).
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)
-> IOEnv (Env DsGblEnv DsLclEnv) (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 {k} (m :: * -> *) (a :: k).
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
  { 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
  ; wrap <- get_wrap
  ; return (MkC $ (foldl' App (wrap (Var rep_id)) xs)) }


dataCon' :: Name -> [CoreExpr] -> MetaM (Core a)
dataCon' :: forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core a)
dataCon' Name
n [CoreExpr]
args = do { 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
                     ; return $ MkC $ mkCoreConApps id args }

dataCon :: Name -> MetaM (Core a)
dataCon :: forall {k} (a :: k). Name -> MetaM (Core a)
dataCon Name
n = Name -> [CoreExpr] -> MetaM (Core a)
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core a)
dataCon' Name
n []


-- %*********************************************************************
-- %*                                                                   *
--              The 'smart constructors'
-- %*                                                                   *
-- %*********************************************************************

--------------- Patterns -----------------
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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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))
-- Note: not Core TH.SumAlt or Core TH.SumArity; it's easier to be direct here
repPunboxedSum :: Core (M Pat) -> Int -> Int -> MetaM (Core (M Pat))
repPunboxedSum (MkC CoreExpr
p) Int
alt Int
arity
 = do { platform <- MetaM Platform
getPlatform
      ; rep2 unboxedSumPName [ p
                             , mkIntExprInt platform alt
                             , mkIntExprInt platform 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
viewPName [CoreExpr
e,CoreExpr
p]

repPor :: Core (NonEmpty (M TH.Pat)) -> MetaM (Core (M TH.Pat))
repPor :: Core (NonEmpty (M Pat)) -> MetaM (Core (M Pat))
repPor (MkC CoreExpr
ps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
orPName [CoreExpr
ps]

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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sigPName [CoreExpr
p, CoreExpr
t]

repPtype :: Core (M TH.Type) -> MetaM (Core (M TH.Pat))
repPtype :: Core (M Type) -> MetaM (Core (M Pat))
repPtype (MkC CoreExpr
t) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
typePName [CoreExpr
t]

repPinvis :: Core (M TH.Type) -> MetaM (Core (M TH.Pat))
repPinvis :: Core (M Type) -> MetaM (Core (M Pat))
repPinvis (MkC CoreExpr
t) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
invisPName [CoreExpr
t]

--------------- Expressions -----------------
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  -- Both type and term variables (#18740)
    | 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
appEName [CoreExpr
x,CoreExpr
y]

repApps :: Core (M TH.Exp) -> [Core (M TH.Exp)] -> MetaM (Core (M TH.Exp))
repApps :: Core (M Exp) -> [Core (M Exp)] -> MetaM (Core (M Exp))
repApps = (Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp)))
-> Core (M Exp) -> [Core (M Exp)] -> MetaM (Core (M Exp))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repApp

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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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))
-- Note: not Core TH.SumAlt or Core TH.SumArity; it's easier to be direct here
repUnboxedSum :: Core (M Exp) -> Int -> Int -> MetaM (Core (M Exp))
repUnboxedSum (MkC CoreExpr
e) Int
alt Int
arity
 = do { platform <- MetaM Platform
getPlatform
      ; rep2 unboxedSumEName [ e
                             , mkIntExprInt platform alt
                             , mkIntExprInt platform 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 coreModName <- MetaM (Core (Maybe ModName))
coreModNameM
    rep2 doName [coreModName, ss]
  where
    coreModNameM :: MetaM (Core (Maybe TH.ModName))
    coreModNameM :: MetaM (Core (Maybe ModName))
coreModNameM = case Maybe ModuleName
maybeModName of
      Just ModuleName
m -> do
        MkC s <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit (ModuleName -> FastString
moduleNameFS ModuleName
m)
        mName <- rep2_nw mkModNameName [s]
        coreJust modNameTyConName 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
implicitParamVarEName [CoreExpr
x]

------------ Right hand sides (guarded expressions) ----
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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
normalBName [CoreExpr
e]

------------ Guards ----
repLNormalGE :: LHsExpr GhcRn -> LHsExpr GhcRn
             -> MetaM (Core (M (TH.Guard, TH.Exp)))
repLNormalGE :: LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M (Guard, Exp)))
repLNormalGE LHsExpr (GhcPass 'Renamed)
g LHsExpr (GhcPass 'Renamed)
e = do g' <- LHsExpr (GhcPass 'Renamed) -> MetaM (Core (M Exp))
repLE LHsExpr (GhcPass 'Renamed)
g
                      e' <- repLE e
                      repNormalGE g' 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
patGEName [CoreExpr
ss, CoreExpr
e]

------------- Stmts -------------------
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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recSName [CoreExpr
ss]

-------------- Range (Arithmetic sequences) -----------
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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fromThenToEName [CoreExpr
x,CoreExpr
y,CoreExpr
z]

------------ Match and Clause Tuples -----------
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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
clauseName [CoreExpr
ps, CoreExpr
bod, CoreExpr
ds]

-------------- Dec -----------------------------
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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
funDName [CoreExpr
nm, CoreExpr
b]

repData :: Bool -- ^ @True@ for a @type data@ declaration.
                -- See Note [Type data declarations] in GHC.Rename.Module
        -> Core (M TH.Cxt) -> Core TH.Name
        -> Either (Core [(M (TH.TyVarBndr TH.BndrVis))])
                  (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 BndrVis)])
     (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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 TH.BndrVis))])
                     (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 BndrVis)])
     (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 {k} (a :: k). 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 {k} (a :: k). 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 TH.BndrVis))]
         -> Core (M TH.Type) -> MetaM (Core (M TH.Dec))
repTySyn :: Core Name
-> Core [M (TyVarBndr BndrVis)]
-> Core (M Type)
-> MetaM (Core (M Dec))
repTySyn (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
rhs)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k).
Maybe (LDerivStrategy (GhcPass 'Renamed))
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy Maybe (LDerivStrategy (GhcPass 'Renamed))
mds Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside =
  case Maybe (LDerivStrategy (GhcPass 'Renamed))
mds of
    Maybe (LDerivStrategy (GhcPass 'Renamed))
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 (GhcPass 'Renamed)
ds ->
      case GenLocated EpAnnCO (DerivStrategy (GhcPass 'Renamed))
-> DerivStrategy (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc LDerivStrategy (GhcPass 'Renamed)
GenLocated EpAnnCO (DerivStrategy (GhcPass 'Renamed))
ds of
        StockStrategy    XStockStrategy (GhcPass 'Renamed)
_ -> 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 (GhcPass 'Renamed)
_ -> 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 (GhcPass 'Renamed)
_ -> 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 (GhcPass 'Renamed)
ty     -> FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall {k} (a :: k).
FreshOrReuse -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds FreshOrReuse
FreshNamesOnly (LHsSigType (GhcPass 'Renamed) -> [Name]
get_scoped_tvs_from_sig XViaStrategy (GhcPass 'Renamed)
LHsSigType (GhcPass 'Renamed)
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 ty' <- LHsSigType (GhcPass 'Renamed) -> MetaM (Core (M Type))
rep_ty_sig' XViaStrategy (GhcPass 'Renamed)
LHsSigType (GhcPass 'Renamed)
ty
                                 via_strat <- repViaStrategy ty'
                                 m_via_strat <- just via_strat
                                 thing_inside 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> MetaM (Core a)
dataCon Name
incoherentDataConName
        NonCanonical 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 {k} (a :: k). 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


repNamespaceSpecifier :: NamespaceSpecifier -> MetaM (Core (TH.NamespaceSpecifier))
repNamespaceSpecifier :: NamespaceSpecifier -> MetaM (Core NamespaceSpecifier)
repNamespaceSpecifier NamespaceSpecifier
ns_spec = case NamespaceSpecifier
ns_spec of
  NoNamespaceSpecifier{} -> Name -> MetaM (Core NamespaceSpecifier)
forall {k} (a :: k). Name -> MetaM (Core a)
dataCon Name
noNamespaceSpecifierDataConName
  TypeNamespaceSpecifier{} -> Name -> MetaM (Core NamespaceSpecifier)
forall {k} (a :: k). Name -> MetaM (Core a)
dataCon Name
typeNamespaceSpecifierDataConName
  DataNamespaceSpecifier{} -> Name -> MetaM (Core NamespaceSpecifier)
forall {k} (a :: k). Name -> MetaM (Core a)
dataCon Name
dataNamespaceSpecifierDataConName

repClass :: Core (M TH.Cxt) -> Core TH.Name -> Core [(M (TH.TyVarBndr TH.BndrVis))]
         -> Core [TH.FunDep] -> Core [(M TH.Dec)]
         -> MetaM (Core (M TH.Dec))
repClass :: Core (M Cxt)
-> Core Name
-> Core [M (TyVarBndr BndrVis)]
-> 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragOpaqueDName [CoreExpr
nm]

repPragSpec :: Core TH.Name -> Core (M TH.Type) -> Maybe (Core (TH.Inline))
            -> Core TH.Phases
            -> MetaM (Core (M TH.Dec))
repPragSpec :: Core Name
-> Core (M Type)
-> Maybe (Core Inline)
-> Core Phases
-> MetaM (Core (M Dec))
repPragSpec (MkC CoreExpr
nm) (MkC CoreExpr
ty) Maybe (Core Inline)
mb_inl (MkC CoreExpr
phases)
  = case Maybe (Core Inline)
mb_inl of
      Maybe (Core Inline)
Nothing ->
        Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecDName [CoreExpr
nm, CoreExpr
ty, CoreExpr
phases]
      Just (MkC CoreExpr
inl) ->
        Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecInlDName [CoreExpr
nm, CoreExpr
ty, CoreExpr
inl, CoreExpr
phases]

repPragSpecE :: Core (Maybe [M (TH.TyVarBndr ())]) -> Core [(M TH.RuleBndr)]
             -> Core (M TH.Exp)
             -> Maybe (Core TH.Inline) -> Core TH.Phases
             -> MetaM (Core (M TH.Dec))
repPragSpecE :: Core (Maybe [M (TyVarBndr ())])
-> Core [M RuleBndr]
-> Core (M Exp)
-> Maybe (Core Inline)
-> Core Phases
-> MetaM (Core (M Dec))
repPragSpecE (MkC CoreExpr
ty_bndrs) (MkC CoreExpr
tm_bndrs) (MkC CoreExpr
expr) Maybe (Core Inline)
mb_inl (MkC CoreExpr
phases)
  = case Maybe (Core Inline)
mb_inl of
      Maybe (Core Inline)
Nothing ->
        Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecEDName    [CoreExpr
ty_bndrs, CoreExpr
tm_bndrs, CoreExpr
expr, CoreExpr
phases]
      Just (MkC CoreExpr
inl) ->
        Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecInlEDName [CoreExpr
ty_bndrs, CoreExpr
tm_bndrs, CoreExpr
expr, CoreExpr
inl, 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragAnnDName [CoreExpr
targ, CoreExpr
e]

repPragSCCFun :: Core TH.Name -> MetaM (Core (M TH.Dec))
repPragSCCFun :: Core Name -> MetaM (Core (M Dec))
repPragSCCFun (MkC CoreExpr
nm) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSCCFunDName [CoreExpr
nm]

repPragSCCFunNamed :: Core TH.Name -> Core String -> MetaM (Core (M TH.Dec))
repPragSCCFunNamed :: Core Name -> Core String -> MetaM (Core (M Dec))
repPragSCCFunNamed (MkC CoreExpr
nm) (MkC CoreExpr
str) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSCCFunNamedDName [CoreExpr
nm, CoreExpr
str]

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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tySynInstDName [CoreExpr
eqn]

repDataFamilyD :: Core TH.Name -> Core [(M (TH.TyVarBndr TH.BndrVis))]
               -> Core (Maybe (M TH.Kind)) -> MetaM (Core (M TH.Dec))
repDataFamilyD :: Core Name
-> Core [M (TyVarBndr BndrVis)]
-> 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
dataFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
kind]

repOpenFamilyD :: Core TH.Name
               -> Core [(M (TH.TyVarBndr TH.BndrVis))]
               -> Core (M TH.FamilyResultSig)
               -> Core (Maybe TH.InjectivityAnn)
               -> MetaM (Core (M TH.Dec))
repOpenFamilyD :: Core Name
-> Core [M (TyVarBndr BndrVis)]
-> 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 {k} (a :: k). 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 TH.BndrVis))]
                 -> Core (M TH.FamilyResultSig)
                 -> Core (Maybe TH.InjectivityAnn)
                 -> Core [(M TH.TySynEqn)]
                 -> MetaM (Core (M TH.Dec))
repClosedFamilyD :: Core Name
-> Core [M (TyVarBndr BndrVis)]
-> 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 (GhcPass 'Renamed) -> MetaM (Core (M Con))
repH98DataCon GenLocated SrcSpanAnnN Name
con HsConDeclH98Details (GhcPass 'Renamed)
details
    = do con' <- GenLocated SrcSpanAnnN Name -> MetaM (Core Name)
forall l. GenLocated l Name -> MetaM (Core Name)
lookupLOcc GenLocated SrcSpanAnnN Name
con -- See Note [Binders and occurrences]
         case details of
           PrefixCon [HsConDeclField (GhcPass 'Renamed)]
ps -> do
             arg_tys <- IsPrefixConGADT
-> [HsConDeclField (GhcPass 'Renamed)] -> MetaM (Core [M BangType])
repPrefixConArgs IsPrefixConGADT
IsNotPrefixConGADT [HsConDeclField (GhcPass 'Renamed)]
ps
             rep2 normalCName [unC con', unC arg_tys]
           InfixCon HsConDeclField (GhcPass 'Renamed)
st1 HsConDeclField (GhcPass 'Renamed)
st2 -> do
             IsPrefixConGADT
-> [HsConDeclField (GhcPass 'Renamed)]
-> ReaderT MetaWrappers DsM ()
verifyLinearFields IsPrefixConGADT
IsNotPrefixConGADT [HsConDeclField (GhcPass 'Renamed)
st1, HsConDeclField (GhcPass 'Renamed)
st2]
             arg1 <- HsConDeclField (GhcPass 'Renamed) -> MetaM (Core (M BangType))
repConDeclField HsConDeclField (GhcPass 'Renamed)
st1
             arg2 <- repConDeclField st2
             rep2 infixCName [unC arg1, unC con', unC arg2]
           RecCon XRec (GhcPass 'Renamed) [LHsConDeclRecField (GhcPass 'Renamed)]
ips -> do
             arg_vtys <- LocatedL [LHsConDeclRecField (GhcPass 'Renamed)]
-> MetaM (Core [M VarBangType])
repRecConArgs XRec (GhcPass 'Renamed) [LHsConDeclRecField (GhcPass 'Renamed)]
LocatedL [LHsConDeclRecField (GhcPass 'Renamed)]
ips
             rep2 recCName [unC con', unC arg_vtys]

repGadtDataCons :: NonEmpty (LocatedN Name)
                -> HsConDeclGADTDetails GhcRn
                -> LHsType GhcRn
                -> MetaM (Core (M TH.Con))
repGadtDataCons :: NonEmpty (GenLocated SrcSpanAnnN Name)
-> HsConDeclGADTDetails (GhcPass 'Renamed)
-> LHsType (GhcPass 'Renamed)
-> MetaM (Core (M Con))
repGadtDataCons NonEmpty (GenLocated SrcSpanAnnN Name)
cons HsConDeclGADTDetails (GhcPass 'Renamed)
details LHsType (GhcPass 'Renamed)
res_ty
    = do 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 -- See Note [Binders and occurrences]
         case details of
           PrefixConGADT XPrefixConGADT (GhcPass 'Renamed)
_ [HsConDeclField (GhcPass 'Renamed)]
ps -> do
             arg_tys <- IsPrefixConGADT
-> [HsConDeclField (GhcPass 'Renamed)] -> MetaM (Core [M BangType])
repPrefixConArgs IsPrefixConGADT
IsPrefixConGADT [HsConDeclField (GhcPass 'Renamed)]
ps
             res_ty' <- repLTy res_ty
             rep2 gadtCName [ unC (nonEmptyCoreList' cons'), unC arg_tys, unC res_ty']
           RecConGADT XRecConGADT (GhcPass 'Renamed)
_ XRec (GhcPass 'Renamed) [LHsConDeclRecField (GhcPass 'Renamed)]
ips -> do
             arg_vtys <- LocatedL [LHsConDeclRecField (GhcPass 'Renamed)]
-> MetaM (Core [M VarBangType])
repRecConArgs XRec (GhcPass 'Renamed) [LHsConDeclRecField (GhcPass 'Renamed)]
LocatedL [LHsConDeclRecField (GhcPass 'Renamed)]
ips
             res_ty'  <- repLTy res_ty
             rep2 recGadtCName [unC (nonEmptyCoreList' cons'), unC arg_vtys,
                                unC res_ty']

-- TH currently only supports linear constructors.
-- We also accept the (->) arrow when -XLinearTypes is off, because this
-- denotes a linear field.
verifyLinearFields :: IsPrefixConGADT -> [HsConDeclField GhcRn] -> MetaM ()
verifyLinearFields :: IsPrefixConGADT
-> [HsConDeclField (GhcPass 'Renamed)]
-> ReaderT MetaWrappers DsM ()
verifyLinearFields IsPrefixConGADT
isPrefixConGADT [HsConDeclField (GhcPass 'Renamed)]
ps = do
  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
$ IsPrefixConGADT -> DsM Bool
forall gbl lcl. IsPrefixConGADT -> TcRnIf gbl lcl Bool
unannotatedMultIsLinear IsPrefixConGADT
isPrefixConGADT
  let allGood = (HsConDeclField (GhcPass 'Renamed) -> Bool)
-> [HsConDeclField (GhcPass 'Renamed)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool
-> HsMultAnnOf
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
     (GhcPass 'Renamed)
-> Bool
forall {pass} {l} {l} {pass}.
(XRec pass (IdOccP pass) ~ GenLocated l (IdOccP pass),
 NamedThing (IdOccP pass)) =>
Bool -> HsMultAnnOf (GenLocated l (HsType pass)) pass -> Bool
hsMultIsLinear Bool
linear (HsMultAnnOf
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
   (GhcPass 'Renamed)
 -> Bool)
-> (HsConDeclField (GhcPass 'Renamed)
    -> HsMultAnnOf
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
         (GhcPass 'Renamed))
-> HsConDeclField (GhcPass 'Renamed)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsConDeclField (GhcPass 'Renamed) -> HsMultAnn (GhcPass 'Renamed)
HsConDeclField (GhcPass 'Renamed)
-> HsMultAnnOf
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
     (GhcPass 'Renamed)
forall pass. HsConDeclField pass -> HsMultAnn pass
cdf_multiplicity) [HsConDeclField (GhcPass 'Renamed)]
ps
  unless allGood $ notHandled ThNonLinearDataCon
  where
    hsMultIsLinear :: Bool -> HsMultAnnOf (GenLocated l (HsType pass)) pass -> Bool
hsMultIsLinear Bool
linear HsUnannotated{} = Bool
linear
    hsMultIsLinear Bool
_ HsLinearAnn{} = Bool
True
    hsMultIsLinear Bool
_ (HsExplicitMult XExplicitMult (GenLocated l (HsType pass)) pass
_ (L l
_ (HsTyVar XTyVar pass
_ PromotionFlag
_ (L l
_ IdOccP pass
n)))) = IdOccP pass -> Name
forall a. NamedThing a => a -> Name
getName IdOccP pass
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
oneDataConName
    hsMultIsLinear Bool
_ HsMultAnnOf (GenLocated l (HsType pass)) pass
_ = Bool
False

-- Desugar the arguments in a data constructor declared with prefix syntax.
repPrefixConArgs :: IsPrefixConGADT -> [HsConDeclField GhcRn] -> MetaM (Core [M TH.BangType])
repPrefixConArgs :: IsPrefixConGADT
-> [HsConDeclField (GhcPass 'Renamed)] -> MetaM (Core [M BangType])
repPrefixConArgs IsPrefixConGADT
isPrefixConGADT [HsConDeclField (GhcPass 'Renamed)]
ps = do
  IsPrefixConGADT
-> [HsConDeclField (GhcPass 'Renamed)]
-> ReaderT MetaWrappers DsM ()
verifyLinearFields IsPrefixConGADT
isPrefixConGADT [HsConDeclField (GhcPass 'Renamed)]
ps
  Name
-> (HsConDeclField (GhcPass 'Renamed) -> MetaM (Core (M BangType)))
-> [HsConDeclField (GhcPass 'Renamed)]
-> MetaM (Core [M BangType])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
bangTypeTyConName HsConDeclField (GhcPass 'Renamed) -> MetaM (Core (M BangType))
repConDeclField [HsConDeclField (GhcPass 'Renamed)]
ps

-- Desugar the arguments in a data constructor declared with record syntax.
repRecConArgs :: LocatedL [LHsConDeclRecField GhcRn]
              -> MetaM (Core [M TH.VarBangType])
repRecConArgs :: LocatedL [LHsConDeclRecField (GhcPass 'Renamed)]
-> MetaM (Core [M VarBangType])
repRecConArgs LocatedL [LHsConDeclRecField (GhcPass 'Renamed)]
lips = do
  let ips :: [HsConDeclRecField (GhcPass 'Renamed)]
ips = (GenLocated SrcSpanAnnA (HsConDeclRecField (GhcPass 'Renamed))
 -> HsConDeclRecField (GhcPass 'Renamed))
-> [GenLocated SrcSpanAnnA (HsConDeclRecField (GhcPass 'Renamed))]
-> [HsConDeclRecField (GhcPass 'Renamed)]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsConDeclRecField (GhcPass 'Renamed))
-> HsConDeclRecField (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc (GenLocated
  SrcSpanAnnL
  [GenLocated SrcSpanAnnA (HsConDeclRecField (GhcPass 'Renamed))]
-> [GenLocated SrcSpanAnnA (HsConDeclRecField (GhcPass 'Renamed))]
forall l e. GenLocated l e -> e
unLoc LocatedL [LHsConDeclRecField (GhcPass 'Renamed)]
GenLocated
  SrcSpanAnnL
  [GenLocated SrcSpanAnnA (HsConDeclRecField (GhcPass 'Renamed))]
lips)
  IsPrefixConGADT
-> [HsConDeclField (GhcPass 'Renamed)]
-> ReaderT MetaWrappers DsM ()
verifyLinearFields IsPrefixConGADT
IsNotPrefixConGADT ((HsConDeclRecField (GhcPass 'Renamed)
 -> HsConDeclField (GhcPass 'Renamed))
-> [HsConDeclRecField (GhcPass 'Renamed)]
-> [HsConDeclField (GhcPass 'Renamed)]
forall a b. (a -> b) -> [a] -> [b]
map HsConDeclRecField (GhcPass 'Renamed)
-> HsConDeclField (GhcPass 'Renamed)
forall pass. HsConDeclRecField pass -> HsConDeclField pass
cdrf_spec [HsConDeclRecField (GhcPass 'Renamed)]
ips)
  args <- (HsConDeclRecField (GhcPass 'Renamed)
 -> ReaderT MetaWrappers DsM [Core (M VarBangType)])
-> [HsConDeclRecField (GhcPass 'Renamed)]
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM HsConDeclRecField (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
rep_ip [HsConDeclRecField (GhcPass 'Renamed)]
ips
  coreListM varBangTypeTyConName args
    where
      rep_ip :: HsConDeclRecField (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
rep_ip HsConDeclRecField (GhcPass 'Renamed)
ip = (GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed))
 -> ReaderT MetaWrappers DsM (Core (M VarBangType)))
-> [GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed))]
-> 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 (HsConDeclField (GhcPass 'Renamed)
-> LFieldOcc (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (Core (M VarBangType))
rep_one_ip (HsConDeclRecField (GhcPass 'Renamed)
-> HsConDeclField (GhcPass 'Renamed)
forall pass. HsConDeclRecField pass -> HsConDeclField pass
cdrf_spec HsConDeclRecField (GhcPass 'Renamed)
ip)) (HsConDeclRecField (GhcPass 'Renamed)
-> [LFieldOcc (GhcPass 'Renamed)]
forall pass. HsConDeclRecField pass -> [LFieldOcc pass]
cdrf_names HsConDeclRecField (GhcPass 'Renamed)
ip)

      rep_one_ip :: HsConDeclField GhcRn -> LFieldOcc GhcRn -> MetaM (Core (M TH.VarBangType))
      rep_one_ip :: HsConDeclField (GhcPass 'Renamed)
-> LFieldOcc (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (Core (M VarBangType))
rep_one_ip HsConDeclField (GhcPass 'Renamed)
t LFieldOcc (GhcPass 'Renamed)
n = do { MkC v  <- Name -> MetaM (Core Name)
lookupOcc (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN Name -> Name)
-> (FieldOcc (GhcPass 'Renamed) -> GenLocated SrcSpanAnnN Name)
-> FieldOcc (GhcPass 'Renamed)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc (GhcPass 'Renamed) -> LIdP (GhcPass 'Renamed)
FieldOcc (GhcPass 'Renamed) -> GenLocated SrcSpanAnnN Name
forall pass. FieldOcc pass -> LIdP pass
foLabel (FieldOcc (GhcPass 'Renamed) -> Name)
-> FieldOcc (GhcPass 'Renamed) -> Name
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed))
-> FieldOcc (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc LFieldOcc (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (FieldOcc (GhcPass 'Renamed))
n)
                          ; MkC ty <- repConDeclField t
                          ; rep2 varBangTypeName [v,ty] }

------------ Types -------------------

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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 { f1 <- Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
f Core (M Type)
t; repTapps f1 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 {k} (a :: k). 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 {k} (a :: k). 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  { tcon <- MetaM (Core (M Type))
repPromotedConsTyCon
                              ; f <- repTapp tcon t
                              ; t' <- repTPromotedList ts
                              ; repTapp f 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
constraintKName []

--------- Type constructors --------------

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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixTName [CoreExpr
t1,CoreExpr
name,CoreExpr
t2]

repTupleTyCon :: Int -> MetaM (Core (M TH.Type))
-- Note: not Core Int; it's easier to be direct here
repTupleTyCon :: Int -> MetaM (Core (M Type))
repTupleTyCon Int
i = do platform <- MetaM Platform
getPlatform
                     rep2 tupleTName [mkIntExprInt platform i]

repUnboxedTupleTyCon :: Int -> MetaM (Core (M TH.Type))
-- Note: not Core Int; it's easier to be direct here
repUnboxedTupleTyCon :: Int -> MetaM (Core (M Type))
repUnboxedTupleTyCon Int
i = do platform <- MetaM Platform
getPlatform
                            rep2 unboxedTupleTName [mkIntExprInt platform i]

repUnboxedSumTyCon :: TH.SumArity -> MetaM (Core (M TH.Type))
-- Note: not Core TH.SumArity; it's easier to be direct here
repUnboxedSumTyCon :: Int -> MetaM (Core (M Type))
repUnboxedSumTyCon Int
arity = do platform <- MetaM Platform
getPlatform
                              rep2 unboxedSumTName [mkIntExprInt platform arity]

repArrowTyCon :: MetaM (Core (M TH.Type))
repArrowTyCon :: MetaM (Core (M Type))
repArrowTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 <- MetaM Platform
getPlatform
                             rep2 promotedTupleTName [mkIntExprInt platform i]

repPromotedNilTyCon :: MetaM (Core (M TH.Type))
repPromotedNilTyCon :: MetaM (Core (M Type))
repPromotedNilTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
promotedConsTName []

----------------------------------------------------------
--       Type family result signature

repNoSig :: MetaM (Core (M TH.FamilyResultSig))
repNoSig :: MetaM (Core (M FamilyResultSig))
repNoSig = Name -> [CoreExpr] -> MetaM (Core (M FamilyResultSig))
forall {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tyVarSigName [CoreExpr
bndr]

----------------------------------------------------------
--              Literals

repLiteral ::  HsLit GhcRn -> MetaM (Core TH.Lit)
repLiteral :: HsLit (GhcPass 'Renamed) -> MetaM (Core Lit)
repLiteral (HsStringPrim XHsStringPrim (GhcPass 'Renamed)
_ ByteString
bs)
  = do word8_ty <- Name -> MetaM Type
lookupType Name
word8TyConName
       let w8s = ByteString -> [Word8]
unpack ByteString
bs
           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
       rep2_nw stringPrimLName [mkListExpr word8_ty w8s_expr]
repLiteral HsLit (GhcPass 'Renamed)
lit
  = do lit' <- case HsLit (GhcPass 'Renamed)
lit of
                   HsIntPrim XHsIntPrim (GhcPass 'Renamed)
_ Integer
i    -> 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)
-> (HsLit GhcTc -> DsM CoreExpr)
-> HsLit GhcTc
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit GhcTc -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit GhcTc -> ReaderT MetaWrappers DsM CoreExpr)
-> ReaderT MetaWrappers DsM (HsLit GhcTc)
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> ReaderT MetaWrappers DsM (HsLit GhcTc)
mk_integer Integer
i
                   HsWordPrim XHsWordPrim (GhcPass 'Renamed)
_ Integer
w   -> 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)
-> (HsLit GhcTc -> DsM CoreExpr)
-> HsLit GhcTc
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit GhcTc -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit GhcTc -> ReaderT MetaWrappers DsM CoreExpr)
-> ReaderT MetaWrappers DsM (HsLit GhcTc)
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> ReaderT MetaWrappers DsM (HsLit GhcTc)
mk_integer Integer
w
                   HsInt XHsInt (GhcPass 'Renamed)
_ IntegralLit
i        -> 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)
-> (HsLit GhcTc -> DsM CoreExpr)
-> HsLit GhcTc
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit GhcTc -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit GhcTc -> ReaderT MetaWrappers DsM CoreExpr)
-> ReaderT MetaWrappers DsM (HsLit GhcTc)
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> ReaderT MetaWrappers DsM (HsLit GhcTc)
mk_integer (IntegralLit -> Integer
il_value IntegralLit
i)
                   HsFloatPrim XHsFloatPrim (GhcPass 'Renamed)
_ FractionalLit
r  -> 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)
-> (HsLit GhcTc -> DsM CoreExpr)
-> HsLit GhcTc
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit GhcTc -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit GhcTc -> ReaderT MetaWrappers DsM CoreExpr)
-> ReaderT MetaWrappers DsM (HsLit GhcTc)
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcTc)
mk_rational FractionalLit
r
                   HsDoublePrim XHsDoublePrim (GhcPass 'Renamed)
_ FractionalLit
r -> 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)
-> (HsLit GhcTc -> DsM CoreExpr)
-> HsLit GhcTc
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit GhcTc -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit GhcTc -> ReaderT MetaWrappers DsM CoreExpr)
-> ReaderT MetaWrappers DsM (HsLit GhcTc)
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcTc)
mk_rational FractionalLit
r
                   HsCharPrim XHsCharPrim (GhcPass 'Renamed)
_ Char
c   -> 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)
-> (HsLit (GhcPass 'Renamed) -> DsM CoreExpr)
-> HsLit (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit (GhcPass 'Renamed) -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit (GhcPass 'Renamed) -> ReaderT MetaWrappers DsM CoreExpr)
-> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
mk_char Char
c
                   HsLit (GhcPass 'Renamed)
_                -> ReaderT MetaWrappers DsM CoreExpr
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReaderT MetaWrappers DsM CoreExpr
 -> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr))
-> (HsLit (GhcPass 'Renamed) -> ReaderT MetaWrappers DsM CoreExpr)
-> HsLit (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
-> (HsLit (GhcPass 'Renamed) -> DsM CoreExpr)
-> HsLit (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit (GhcPass 'Renamed) -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit (GhcPass 'Renamed)
 -> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr))
-> HsLit (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall a b. (a -> b) -> a -> b
$ HsLit (GhcPass 'Renamed)
lit
       lit_expr <- lit'
       case 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 (GhcPass 'Renamed) -> ThRejectionReason
ThExoticLiteral HsLit (GhcPass 'Renamed)
lit)
  where
    mb_lit_name :: Maybe Name
mb_lit_name = case HsLit (GhcPass 'Renamed)
lit of
                 HsInt XHsInt (GhcPass 'Renamed)
_ IntegralLit
_        -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
integerLName
                 HsIntPrim XHsIntPrim (GhcPass 'Renamed)
_ Integer
_    -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
intPrimLName
                 HsWordPrim XHsWordPrim (GhcPass 'Renamed)
_ Integer
_   -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
wordPrimLName
                 HsFloatPrim XHsFloatPrim (GhcPass 'Renamed)
_ FractionalLit
_  -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
floatPrimLName
                 HsDoublePrim XHsDoublePrim (GhcPass 'Renamed)
_ FractionalLit
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
doublePrimLName
                 HsChar XHsChar (GhcPass 'Renamed)
_ Char
_       -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
charLName
                 HsCharPrim XHsCharPrim (GhcPass 'Renamed)
_ Char
_   -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
charPrimLName
                 HsString XHsString (GhcPass 'Renamed)
_ FastString
_     -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
stringLName
                 HsMultilineString XHsMultilineString (GhcPass 'Renamed)
_ FastString
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
stringLName
                 HsLit (GhcPass 'Renamed)
_                -> Maybe Name
forall a. Maybe a
Nothing

mk_integer :: Integer -> MetaM (HsLit GhcTc)
mk_integer :: Integer -> ReaderT MetaWrappers DsM (HsLit GhcTc)
mk_integer  Integer
i = HsLit GhcTc -> ReaderT MetaWrappers DsM (HsLit GhcTc)
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcTc -> ReaderT MetaWrappers DsM (HsLit GhcTc))
-> HsLit GhcTc -> ReaderT MetaWrappers DsM (HsLit GhcTc)
forall a b. (a -> b) -> a -> b
$ XXLit GhcTc -> HsLit GhcTc
forall x. XXLit x -> HsLit x
XLit (XXLit GhcTc -> HsLit GhcTc) -> XXLit GhcTc -> HsLit GhcTc
forall a b. (a -> b) -> a -> b
$ SourceText -> Integer -> Type -> HsLitTc
HsInteger SourceText
NoSourceText Integer
i Type
integerTy

mk_rational :: FractionalLit -> MetaM (HsLit GhcTc)
mk_rational :: FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcTc)
mk_rational FractionalLit
r = do rat_ty <- Name -> MetaM Type
lookupType Name
rationalTyConName
                   return $ XLit $ HsRat r rat_ty

mk_string :: FastString -> MetaM (HsLit GhcRn)
mk_string :: FastString -> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
mk_string FastString
s = HsLit (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Renamed)
 -> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed)))
-> HsLit (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XHsString (GhcPass 'Renamed)
-> FastString -> HsLit (GhcPass 'Renamed)
forall x. XHsString x -> FastString -> HsLit x
HsString XHsString (GhcPass 'Renamed)
SourceText
NoSourceText FastString
s

mk_char :: Char -> MetaM (HsLit GhcRn)
mk_char :: Char -> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
mk_char Char
c = HsLit (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
forall a. a -> ReaderT MetaWrappers DsM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Renamed)
 -> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed)))
-> HsLit (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XHsChar (GhcPass 'Renamed) -> Char -> HsLit (GhcPass 'Renamed)
forall x. XHsChar x -> Char -> HsLit x
HsChar XHsChar (GhcPass 'Renamed)
SourceText
NoSourceText Char
c

repOverloadedLiteral :: HsOverLit GhcRn -> MetaM (Core TH.Lit)
repOverloadedLiteral :: HsOverLit (GhcPass 'Renamed) -> MetaM (Core Lit)
repOverloadedLiteral (OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = OverLitVal
val})
  = OverLitVal -> MetaM (Core Lit)
repOverLiteralVal OverLitVal
val
    -- The type Rational will be in the environment, because
    -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
    -- and rationalL is sucked in when any TH stuff is used

repOverLiteralVal ::  OverLitVal -> MetaM (Core TH.Lit)
repOverLiteralVal :: OverLitVal -> MetaM (Core Lit)
repOverLiteralVal OverLitVal
lit = do
  lit' <- case OverLitVal
lit of
        (HsIntegral IntegralLit
i)   -> 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)
-> (HsLit GhcTc -> DsM CoreExpr)
-> HsLit GhcTc
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit GhcTc -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit GhcTc -> ReaderT MetaWrappers DsM CoreExpr)
-> ReaderT MetaWrappers DsM (HsLit GhcTc)
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> ReaderT MetaWrappers DsM (HsLit GhcTc)
mk_integer  (IntegralLit -> Integer
il_value IntegralLit
i)
        (HsFractional FractionalLit
f) -> 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)
-> (HsLit GhcTc -> DsM CoreExpr)
-> HsLit GhcTc
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit GhcTc -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit GhcTc -> ReaderT MetaWrappers DsM CoreExpr)
-> ReaderT MetaWrappers DsM (HsLit GhcTc)
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcTc)
mk_rational FractionalLit
f
        (HsIsString SourceText
_ FastString
s) -> 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)
-> (HsLit (GhcPass 'Renamed) -> DsM CoreExpr)
-> HsLit (GhcPass 'Renamed)
-> ReaderT MetaWrappers DsM CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit (GhcPass 'Renamed) -> DsM CoreExpr
forall (p :: Pass). IsPass p => HsLit (GhcPass p) -> DsM CoreExpr
dsLit (HsLit (GhcPass 'Renamed) -> ReaderT MetaWrappers DsM CoreExpr)
-> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
-> ReaderT MetaWrappers DsM (ReaderT MetaWrappers DsM CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> ReaderT MetaWrappers DsM (HsLit (GhcPass 'Renamed))
mk_string   FastString
s
  lit_expr <- lit'

  let lit_name = case OverLitVal
lit of
        (HsIntegral IntegralLit
_  ) -> Name
integerLName
        (HsFractional FractionalLit
_) -> Name
rationalLName
        (HsIsString SourceText
_ FastString
_) -> Name
stringLName

  rep2_nw lit_name [lit_expr]

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
      mod <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
name_mod
      occ <- occNameLit occ
      repNameQ mod 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]

--------------- Miscellaneous -------------------

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 {k} (a :: k). Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
newNameName [CoreExpr
lit_str]

repBindM :: Type -> Type        -- a and b
         -> Core (M a) -> Core (a -> M b) -> MetaM (Core (M b))
repBindM :: forall {k} a (b :: k).
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 {k} (a :: k). 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 {k} (a :: k). 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 {k} (a :: k). 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 s <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
fs
                    rep2 labelEName [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 s <- FastString -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *).
MonadThings m =>
FastString -> m (Core String)
coreStringLit FastString
fs
  rep2 getFieldEName [exp,s]

repProjection :: NonEmpty FastString -> MetaM (Core (M TH.Exp))
repProjection :: NonEmpty FastString -> MetaM (Core (M Exp))
repProjection NonEmpty FastString
fs = do
  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 xs <- coreListNonEmpty ne_tycon stringTy <$>
            mapM coreStringLit fs
  rep2 projectionEName [xs]

------------ Lists -------------------
-- turn a list of patterns into a single pattern matching a list

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 { 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
       ; coreList tc_name args1 }

-- Create a list of m a values
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 { ty <- Name -> MetaM Type
wrapName Name
tc_name
       ; args1 <- mapM f args
       ; return $ coreList' ty args1 }

repNonEmptyM
  :: Name
  -> (a  -> MetaM (Core b))
  -> NonEmpty a -> MetaM (Core (NonEmpty b))
repNonEmptyM :: forall a b.
Name
-> (a -> MetaM (Core b)) -> NonEmpty a -> MetaM (Core (NonEmpty b))
repNonEmptyM Name
tc_name a -> MetaM (Core b)
f NonEmpty a
args
  = do { ty <- Name -> MetaM Type
wrapName Name
tc_name
       ; args' <- traverse f args
       ; ne_tycon <- lift $ dsLookupTyCon nonEmptyTyConName -- the DataCon is not known-key
       ; return $ coreListNonEmpty ne_tycon ty args' }

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    -- Of the TyCon of the element type
         -> [Core a] -> MetaM (Core [a])
coreList :: forall a. Name -> [Core a] -> MetaM (Core [a])
coreList Name
tc_name [Core a]
es
  = do { elt_ty <- Name -> MetaM Type
lookupType Name
tc_name; return (coreList' elt_ty es) }

coreList' :: Type       -- The element type
          -> [Core a] -> Core [a]
coreList' :: forall a. Type -> [Core a] -> Core [a]
coreList' Type
elt_ty [Core a]
es = CoreExpr -> Core [a]
forall {k} (a :: k). 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 {k} (a :: k). Core a -> CoreExpr
unC [Core a]
es ))

coreListNonEmpty :: TyCon -- TyCon for NonEmpty
                 -> Type  -- Element 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 {k} (a :: k). 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 {k} (a :: k). Core a -> CoreExpr
unC [Core a]
xs)]

nonEmptyCoreList :: [Core a] -> Core [a]
  -- The list must be non-empty so we can get the element type
  -- Otherwise use coreList
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 {k} (a :: k). CoreExpr -> Core a
MkC (Type -> [CoreExpr] -> CoreExpr
mkListExpr (HasDebugCallStack => 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 {k} (a :: k). 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 {k} (a :: k). CoreExpr -> Core a
MkC (Type -> [CoreExpr] -> CoreExpr
mkListExpr (HasDebugCallStack => CoreExpr -> Type
CoreExpr -> Type
exprType CoreExpr
x) (NonEmpty CoreExpr -> [CoreExpr]
forall a. NonEmpty 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 {k} (a :: k). 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 { z <- FastString -> m CoreExpr
forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
mkStringExprFS FastString
s; return (MkC z) }

------------------- Maybe ------------------

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
  t <- Name -> MetaM Type
lookupType Name
tc_name
  repMaybeT t f 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

-- | Construct Core expression for Nothing of a given type name
coreNothing :: Name        -- ^ Name of the TyCon of the element type
            -> MetaM (Core (Maybe a))
coreNothing :: forall a. Name -> MetaM (Core (Maybe a))
coreNothing Name
tc_name =
    do { elt_ty <- Name -> MetaM Type
lookupType Name
tc_name; return (coreNothing' elt_ty) }

coreNothingM :: Name -> MetaM (Core (Maybe a))
coreNothingM :: forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
tc_name =
    do { elt_ty <- Name -> MetaM Type
wrapName Name
tc_name; return (coreNothing' elt_ty) }

-- | Construct Core expression for Nothing of a given type
coreNothing' :: Type       -- ^ The element type
             -> Core (Maybe a)
coreNothing' :: forall a. Type -> Core (Maybe a)
coreNothing' Type
elt_ty = CoreExpr -> Core (Maybe a)
forall {k} (a :: k). CoreExpr -> Core a
MkC (Type -> CoreExpr
mkNothingExpr Type
elt_ty)

-- | Store given Core expression in a Just of a given type name
coreJust :: Name        -- ^ Name of the TyCon of the element type
         -> Core a -> MetaM (Core (Maybe a))
coreJust :: forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJust Name
tc_name Core a
es
  = do { elt_ty <- Name -> MetaM Type
lookupType Name
tc_name; return (coreJust' elt_ty 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 { elt_ty <- Name -> MetaM Type
wrapName Name
tc_name; return (coreJust' elt_ty es) }

-- | Store given Core expression in a Just of a given type
coreJust' :: Type       -- ^ The element 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 {k} (a :: k). CoreExpr -> Core a
MkC (Type -> CoreExpr -> CoreExpr
mkJustExpr Type
elt_ty (Core a -> CoreExpr
forall {k} (a :: k). Core a -> CoreExpr
unC Core a
es))

------------------- Maybe Lists ------------------

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)

------------ Literals & Variables -------------------

coreIntLit :: Int -> MetaM (Core Int)
coreIntLit :: Int -> MetaM (Core Int)
coreIntLit Int
i = do platform <- MetaM Platform
getPlatform
                  return (MkC (mkIntExprInt platform i))

coreVar :: Id -> Core TH.Name   -- The Id has type Name
coreVar :: Id -> Core Name
coreVar Id
id = CoreExpr -> Core Name
forall {k} (a :: k). CoreExpr -> Core a
MkC (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
id)

----------------- Failure -----------------------
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)