{-# LANGUAGE CPP, TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-----------------------------------------------------------------------------
--
-- (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

#include "HsVersions.h"

import GHC.Prelude
import GHC.Platform

import {-# SOURCE #-}   GHC.HsToCore.Expr ( dsExpr )

import GHC.HsToCore.Match.Literal
import GHC.HsToCore.Monad

import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH

import GHC.Hs
import GHC.Builtin.Names

import GHC.Unit.Module
import GHC.Types.Id
import GHC.Types.Name hiding( varName, tcName )
import GHC.Builtin.Names.TH
import GHC.Types.Name.Env
import GHC.Tc.Utils.TcType
import GHC.Core.TyCon
import GHC.Builtin.Types
import GHC.Core.Multiplicity ( pattern Many )
import GHC.Core
import GHC.Core.Make
import GHC.Core.Utils
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Unique
import GHC.Types.Basic
import GHC.Utils.Outputable
import GHC.Data.Bag
import GHC.Driver.Session
import GHC.Data.FastString
import GHC.Types.ForeignCall
import GHC.Utils.Misc
import GHC.Data.Maybe
import GHC.Utils.Monad
import GHC.Tc.Types.Evidence
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import GHC.Core.Class
import GHC.Driver.Types ( MonadThings )
import GHC.Core.DataCon
import GHC.Types.Var
import GHC.HsToCore.Binds

import GHC.TypeLits
import Data.Kind (Constraint)

import Data.ByteString ( unpack )
import Control.Monad
import Data.List
import Data.Function

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.
      TyCon
quote_tc <- Name -> DsM TyCon
dsLookupTyCon Name
quoteClassName
      TyCon
monad_tc <- Name -> DsM TyCon
dsLookupTyCon Name
monadClassName
      let Just Class
cls = TyCon -> Maybe Class
tyConClass_maybe TyCon
quote_tc
          Just Class
monad_cls = TyCon -> Maybe Class
tyConClass_maybe TyCon
monad_tc
          -- Quote m -> Monad m
          monad_sel :: Id
monad_sel = Class -> Int -> Id
classSCSelId Class
cls Int
0

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

      MASSERT2( idType monad_sel `eqType` expected_ty, ppr monad_sel $$ ppr expected_ty)

      let m_ty :: CoreExpr
m_ty = Type -> CoreExpr
forall b. Type -> Expr b
Type Type
m_var
          -- Construct the contents of MetaWrappers
          quoteWrapper :: HsWrapper
quoteWrapper = QuoteWrapper -> HsWrapper
applyQuoteWrapper QuoteWrapper
q
          monadWrapper :: HsWrapper
monadWrapper = [EvTerm] -> HsWrapper
mkWpEvApps [CoreExpr -> EvTerm
EvExpr (CoreExpr -> EvTerm) -> CoreExpr -> EvTerm
forall a b. (a -> b) -> a -> b
$ CoreExpr -> [CoreExpr] -> CoreExpr
mkCoreApps (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
monad_sel) [CoreExpr
m_ty, CoreExpr
quote_var]] HsWrapper -> HsWrapper -> HsWrapper
<.>
                            [Type] -> HsWrapper
mkWpTyApps [Type
m_var]
          tyWrapper :: Type -> Type
tyWrapper Type
t = Type -> Type -> Type
mkAppTy Type
m_var Type
t
          debug :: (HsWrapper, HsWrapper, Type)
debug = (HsWrapper
quoteWrapper, HsWrapper
monadWrapper, Type
m_var)
      CoreExpr -> CoreExpr
q_f <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
dsHsWrapper HsWrapper
quoteWrapper
      CoreExpr -> CoreExpr
m_f <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
dsHsWrapper HsWrapper
monadWrapper
      MetaWrappers -> DsM MetaWrappers
forall (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
  Type
t <- Name -> MetaM Type
lookupType Name
n
  Type -> Type
wrap_fn <- (MetaWrappers -> Type -> Type)
-> ReaderT MetaWrappers DsM (Type -> Type)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks MetaWrappers -> Type -> Type
metaTy
  Type -> MetaM Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Type
wrap_fn Type
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 :: Maybe QuoteWrapper -- ^ This is Nothing only when we are dealing with a VarBr
          -> HsBracket GhcRn
          -> [PendingTcSplice]
          -> 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 :: Maybe QuoteWrapper
-> HsBracket GhcRn -> [PendingTcSplice] -> DsM CoreExpr
dsBracket Maybe QuoteWrapper
wrap HsBracket GhcRn
brack [PendingTcSplice]
splices
  = HsBracket GhcRn -> DsM CoreExpr
do_brack HsBracket GhcRn
brack

  where
    runOverloaded :: ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded ReaderT MetaWrappers DsM CoreExpr
act = do
      -- In the overloaded case we have to get given a wrapper, it is just
      -- for variable quotations that there is no wrapper, because they
      -- have a simple type.
      MetaWrappers
mw <- QuoteWrapper -> DsM MetaWrappers
mkMetaWrappers (String -> Maybe QuoteWrapper -> QuoteWrapper
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"runOverloaded" Maybe QuoteWrapper
wrap)
      ReaderT MetaWrappers DsM CoreExpr -> MetaWrappers -> DsM CoreExpr
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr
-> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (DsMetaEnv -> DsM CoreExpr -> DsM CoreExpr
forall a. DsMetaEnv -> DsM a -> DsM a
dsExtendMetaEnv DsMetaEnv
new_bit) ReaderT MetaWrappers DsM CoreExpr
act) MetaWrappers
mw


    new_bit :: DsMetaEnv
new_bit = [(Name, DsMetaVal)] -> DsMetaEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name
n, HsExpr GhcTc -> DsMetaVal
DsSplice (GenLocated SrcSpan (HsExpr GhcTc) -> HsExpr GhcTc
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (HsExpr GhcTc)
e))
                        | PendingTcSplice Name
n GenLocated SrcSpan (HsExpr GhcTc)
e <- [PendingTcSplice]
splices]

    do_brack :: HsBracket GhcRn -> DsM CoreExpr
do_brack (VarBr XVarBr GhcRn
_ Bool
_ IdP GhcRn
n) = do { MkC CoreExpr
e1  <- Name -> DsM (Core Name)
lookupOccDsM Name
IdP GhcRn
n ; CoreExpr -> DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1 }
    do_brack (ExpBr XExpBr GhcRn
_ LHsExpr GhcRn
e)   = ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded (ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ do { MkC CoreExpr
e1  <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e     ; CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1 }
    do_brack (PatBr XPatBr GhcRn
_ LPat GhcRn
p)   = ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded (ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ do { MkC CoreExpr
p1  <- LPat GhcRn -> MetaM (Core (M Pat))
repTopP LPat GhcRn
p   ; CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
p1 }
    do_brack (TypBr XTypBr GhcRn
_ LHsType GhcRn
t)   = ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded (ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ do { MkC CoreExpr
t1  <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
t    ; CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
t1 }
    do_brack (DecBrG XDecBrG GhcRn
_ HsGroup GhcRn
gp) = ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded (ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ do { MkC CoreExpr
ds1 <- HsGroup GhcRn -> MetaM (Core (M [Dec]))
repTopDs HsGroup GhcRn
gp ; CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
ds1 }
    do_brack (DecBrL {})   = String -> DsM CoreExpr
forall a. String -> a
panic String
"dsBracket: unexpected DecBrL"
    do_brack (TExpBr XTExpBr GhcRn
_ LHsExpr GhcRn
e)  = ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
runOverloaded (ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr)
-> ReaderT MetaWrappers DsM CoreExpr -> DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ do { MkC CoreExpr
e1  <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e     ; CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1 }

{-
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 GhcRn -> MetaM (Core (M Pat))
repTopP LPat GhcRn
pat = do { [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms (LPat GhcRn -> [IdP GhcRn]
forall p. CollectPass p => LPat p -> [IdP p]
collectPatBinders LPat GhcRn
pat)
                 ; Core (M Pat)
pat' <- [GenSymBind] -> MetaM (Core (M Pat)) -> MetaM (Core (M Pat))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
pat)
                 ; [GenSymBind] -> Core (M Pat) -> MetaM (Core (M Pat))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Pat)
pat' }

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

        [Core (M Dec)]
decls <- [GenSymBind] -> MetaM [Core (M Dec)] -> MetaM [Core (M Dec)]
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (
                  do { [(SrcSpan, Core (M Dec))]
val_ds   <- HsValBinds GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_val_binds HsValBinds GhcRn
valds
                     ; [Any]
_        <- (LSpliceDecl GhcRn -> ReaderT MetaWrappers DsM Any)
-> [LSpliceDecl GhcRn] -> ReaderT MetaWrappers DsM [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LSpliceDecl GhcRn -> ReaderT MetaWrappers DsM Any
forall {e} {a}. GenLocated SrcSpan e -> MetaM a
no_splice [LSpliceDecl GhcRn]
splcds
                     ; [Maybe (SrcSpan, Core (M Dec))]
tycl_ds  <- (LTyClDecl GhcRn
 -> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec))))
-> [LTyClDecl GhcRn]
-> ReaderT MetaWrappers DsM [Maybe (SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LTyClDecl GhcRn
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
repTyClD ([TyClGroup GhcRn] -> [LTyClDecl GhcRn]
forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls [TyClGroup GhcRn]
tyclds)
                     ; [(SrcSpan, Core (M Dec))]
role_ds  <- (LRoleAnnotDecl GhcRn
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [LRoleAnnotDecl GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LRoleAnnotDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRoleD ((TyClGroup GhcRn -> [LRoleAnnotDecl GhcRn])
-> [TyClGroup GhcRn] -> [LRoleAnnotDecl GhcRn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyClGroup GhcRn -> [LRoleAnnotDecl GhcRn]
forall pass. TyClGroup pass -> [LRoleAnnotDecl pass]
group_roles [TyClGroup GhcRn]
tyclds)
                     ; [(SrcSpan, Core (M Dec))]
kisig_ds <- (LStandaloneKindSig GhcRn
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [LStandaloneKindSig GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LStandaloneKindSig GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repKiSigD ((TyClGroup GhcRn -> [LStandaloneKindSig GhcRn])
-> [TyClGroup GhcRn] -> [LStandaloneKindSig GhcRn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyClGroup GhcRn -> [LStandaloneKindSig GhcRn]
forall pass. TyClGroup pass -> [LStandaloneKindSig pass]
group_kisigs [TyClGroup GhcRn]
tyclds)
                     ; [(SrcSpan, Core (M Dec))]
inst_ds  <- (LInstDecl GhcRn
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [LInstDecl GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LInstDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repInstD [LInstDecl GhcRn]
instds
                     ; [(SrcSpan, Core (M Dec))]
deriv_ds <- (LDerivDecl GhcRn
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [LDerivDecl GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LDerivDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repStandaloneDerivD [LDerivDecl GhcRn]
derivds
                     ; [[(SrcSpan, Core (M Dec))]]
fix_ds   <- (LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))])
-> [LFixitySig GhcRn]
-> ReaderT MetaWrappers DsM [[(SrcSpan, Core (M Dec))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
repLFixD [LFixitySig GhcRn]
fixds
                     ; [Any]
_        <- (LDefaultDecl GhcRn -> ReaderT MetaWrappers DsM Any)
-> [LDefaultDecl GhcRn] -> ReaderT MetaWrappers DsM [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LDefaultDecl GhcRn -> ReaderT MetaWrappers DsM Any
forall {a} {a}. Outputable a => GenLocated SrcSpan a -> MetaM a
no_default_decl [LDefaultDecl GhcRn]
defds
                     ; [(SrcSpan, Core (M Dec))]
for_ds   <- (Located (ForeignDecl GhcRn)
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [Located (ForeignDecl GhcRn)] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located (ForeignDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repForD [Located (ForeignDecl GhcRn)]
fords
                     ; [Any]
_        <- (LWarnDecl GhcRn -> ReaderT MetaWrappers DsM Any)
-> [LWarnDecl GhcRn] -> ReaderT MetaWrappers DsM [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LWarnDecl GhcRn -> ReaderT MetaWrappers DsM Any
forall a. LWarnDecl GhcRn -> MetaM a
no_warn ((LWarnDecls GhcRn -> [LWarnDecl GhcRn])
-> [LWarnDecls GhcRn] -> [LWarnDecl GhcRn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (WarnDecls GhcRn -> [LWarnDecl GhcRn]
forall pass. WarnDecls pass -> [LWarnDecl pass]
wd_warnings (WarnDecls GhcRn -> [LWarnDecl GhcRn])
-> (LWarnDecls GhcRn -> WarnDecls GhcRn)
-> LWarnDecls GhcRn
-> [LWarnDecl GhcRn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LWarnDecls GhcRn -> WarnDecls GhcRn
forall l e. GenLocated l e -> e
unLoc)
                                                           [LWarnDecls GhcRn]
warnds)
                     ; [(SrcSpan, Core (M Dec))]
ann_ds   <- (LAnnDecl GhcRn
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [LAnnDecl GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LAnnDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repAnnD [LAnnDecl GhcRn]
annds
                     ; [(SrcSpan, Core (M Dec))]
rule_ds  <- (LRuleDecl GhcRn
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [LRuleDecl GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LRuleDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRuleD ((LRuleDecls GhcRn -> [LRuleDecl GhcRn])
-> [LRuleDecls GhcRn] -> [LRuleDecl GhcRn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RuleDecls GhcRn -> [LRuleDecl GhcRn]
forall pass. RuleDecls pass -> [LRuleDecl pass]
rds_rules (RuleDecls GhcRn -> [LRuleDecl GhcRn])
-> (LRuleDecls GhcRn -> RuleDecls GhcRn)
-> LRuleDecls GhcRn
-> [LRuleDecl GhcRn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LRuleDecls GhcRn -> RuleDecls GhcRn
forall l e. GenLocated l e -> e
unLoc)
                                                            [LRuleDecls GhcRn]
ruleds)
                     ; [Any]
_        <- (LDocDecl -> ReaderT MetaWrappers DsM Any)
-> [LDocDecl] -> ReaderT MetaWrappers DsM [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LDocDecl -> ReaderT MetaWrappers DsM Any
forall {e} {a}. GenLocated SrcSpan e -> MetaM a
no_doc [LDocDecl]
docs

                        -- more needed
                     ;  [Core (M Dec)] -> MetaM [Core (M Dec)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core (M Dec))] -> [Core (M Dec)])
-> [(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. (a -> b) -> a -> b
$ [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc ([(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))])
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a b. (a -> b) -> a -> b
$
                                [(SrcSpan, Core (M Dec))]
val_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [Maybe (SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (SrcSpan, Core (M Dec))]
tycl_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
role_ds
                                       [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
kisig_ds
                                       [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ ([[(SrcSpan, Core (M Dec))]] -> [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(SrcSpan, Core (M Dec))]]
fix_ds)
                                       [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
inst_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
rule_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
for_ds
                                       [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
ann_ds [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
deriv_ds) }) ;

        Core [M Dec]
core_list <- Name
-> (Core (M Dec) -> MetaM (Core (M Dec)))
-> [Core (M Dec)]
-> MetaM (Core [M Dec])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
decTyConName Core (M Dec) -> MetaM (Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return [Core (M Dec)]
decls ;

        Type
dec_ty <- Name -> MetaM Type
lookupType Name
decTyConName ;
        Core (M [Dec])
q_decs  <- Type -> Core [M Dec] -> MetaM (Core (M [Dec]))
forall a. Type -> Core [M a] -> MetaM (Core (M [a]))
repSequenceM Type
dec_ty Core [M Dec]
core_list ;

        [GenSymBind] -> Core (M [Dec]) -> MetaM (Core (M [Dec]))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M [Dec])
q_decs
      }
  where
    no_splice :: GenLocated SrcSpan e -> MetaM a
no_splice (L SrcSpan
loc e
_)
      = SrcSpan -> String -> SDoc -> MetaM a
forall a. SrcSpan -> String -> SDoc -> MetaM a
notHandledL SrcSpan
loc String
"Splices within declaration brackets" SDoc
empty
    no_default_decl :: GenLocated SrcSpan a -> MetaM a
no_default_decl (L SrcSpan
loc a
decl)
      = SrcSpan -> String -> SDoc -> MetaM a
forall a. SrcSpan -> String -> SDoc -> MetaM a
notHandledL SrcSpan
loc String
"Default declarations" (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
decl)
    no_warn :: LWarnDecl GhcRn -> MetaM a
    no_warn :: forall a. LWarnDecl GhcRn -> MetaM a
no_warn (L SrcSpan
loc (Warning XWarning GhcRn
_ [Located (IdP GhcRn)]
thing WarningTxt
_))
      = SrcSpan -> String -> SDoc -> MetaM a
forall a. SrcSpan -> String -> SDoc -> MetaM a
notHandledL SrcSpan
loc String
"WARNING and DEPRECATION pragmas" (SDoc -> MetaM a) -> SDoc -> MetaM a
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
text String
"Pragma for declaration of" SDoc -> SDoc -> SDoc
<+> [Located Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Located Name]
[Located (IdP GhcRn)]
thing
    no_doc :: GenLocated SrcSpan e -> MetaM a
no_doc (L SrcSpan
loc e
_)
      = SrcSpan -> String -> SDoc -> MetaM a
forall a. SrcSpan -> String -> SDoc -> MetaM a
notHandledL SrcSpan
loc String
"Haddock documentation" SDoc
empty

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

get_scoped_tvs :: LSig GhcRn -> [Name]
get_scoped_tvs :: LSig GhcRn -> [Name]
get_scoped_tvs (L SrcSpan
_ Sig GhcRn
signature)
  | TypeSig XTypeSig GhcRn
_ [Located (IdP GhcRn)]
_ LHsSigWcType GhcRn
sig <- Sig GhcRn
signature
  = LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig (LHsSigWcType GhcRn -> LHsSigType GhcRn
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsSigWcType GhcRn
sig)
  | ClassOpSig XClassOpSig GhcRn
_ Bool
_ [Located (IdP GhcRn)]
_ LHsSigType GhcRn
sig <- Sig GhcRn
signature
  = LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig LHsSigType GhcRn
sig
  | PatSynSig XPatSynSig GhcRn
_ [Located (IdP GhcRn)]
_ LHsSigType GhcRn
sig <- Sig GhcRn
signature
  = LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig LHsSigType GhcRn
sig
  | Bool
otherwise
  = []

get_scoped_tvs_from_sig :: LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig :: LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig LHsSigType GhcRn
sig
  -- 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]
  | HsIB { hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
hsib_ext = XHsIB GhcRn (LHsType GhcRn)
implicit_vars
         , hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcRn
hs_ty } <- LHsSigType GhcRn
sig
  , ([LHsTyVarBndr Specificity GhcRn]
explicit_vars, LHsType GhcRn
_) <- LHsType GhcRn -> ([LHsTyVarBndr Specificity GhcRn], LHsType GhcRn)
forall pass.
LHsType pass -> ([LHsTyVarBndr Specificity pass], LHsType pass)
splitLHsForAllTyInvis LHsType GhcRn
hs_ty
  = [Name]
XHsIB GhcRn (LHsType GhcRn)
implicit_vars [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [LHsTyVarBndr Specificity GhcRn] -> [IdP GhcRn]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr Specificity GhcRn]
explicit_vars

{- 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 GhcRn
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
repTyClD (L SrcSpan
loc (FamDecl { tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam = FamilyDecl GhcRn
fam })) = ((SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec)))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec))
forall a. a -> Maybe a
Just (ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
 -> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec))))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall a b. (a -> b) -> a -> b
$
                                              LFamilyDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repFamilyDecl (SrcSpan -> FamilyDecl GhcRn -> LFamilyDecl GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc FamilyDecl GhcRn
fam)

repTyClD (L SrcSpan
loc (SynDecl { tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = Located (IdP GhcRn)
tc, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
tvs, tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LHsType GhcRn
rhs }))
  = do { Core Name
tc1 <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
tc           -- See note [Binders and occurrences]
       ; Core (M Dec)
dec <- LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyClTyVarBinds LHsQTyVars GhcRn
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
 -> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
                Core Name
-> Core [M (TyVarBndr ())] -> LHsType GhcRn -> MetaM (Core (M Dec))
repSynDecl Core Name
tc1 Core [M (TyVarBndr ())]
bndrs LHsType GhcRn
rhs
       ; Maybe (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall (m :: * -> *) a. Monad m => a -> m a
return ((SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec))
forall a. a -> Maybe a
Just (SrcSpan
loc, Core (M Dec)
dec)) }

repTyClD (L SrcSpan
loc (DataDecl { tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = Located (IdP GhcRn)
tc
                          , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
tvs
                          , tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn GhcRn
defn }))
  = do { Core Name
tc1 <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
tc           -- See note [Binders and occurrences]
       ; Core (M Dec)
dec <- LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyClTyVarBinds LHsQTyVars GhcRn
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
 -> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
                Core Name
-> Either
     (Core [M (TyVarBndr ())])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> HsDataDefn GhcRn
-> MetaM (Core (M Dec))
repDataDefn Core Name
tc1 (Core [M (TyVarBndr ())]
-> Either
     (Core [M (TyVarBndr ())])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
forall a b. a -> Either a b
Left Core [M (TyVarBndr ())]
bndrs) HsDataDefn GhcRn
defn
       ; Maybe (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall (m :: * -> *) a. Monad m => a -> m a
return ((SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec))
forall a. a -> Maybe a
Just (SrcSpan
loc, Core (M Dec)
dec)) }

repTyClD (L SrcSpan
loc (ClassDecl { tcdCtxt :: forall pass. TyClDecl pass -> LHsContext pass
tcdCtxt = LHsContext GhcRn
cxt, tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = Located (IdP GhcRn)
cls,
                             tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
tvs, tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdFDs = [LHsFunDep GhcRn]
fds,
                             tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig GhcRn]
sigs, tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths = LHsBindsLR GhcRn GhcRn
meth_binds,
                             tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs = [LFamilyDecl GhcRn]
ats, tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs = [LTyFamDefltDecl GhcRn]
atds }))
  = do { Core Name
cls1 <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
cls         -- See note [Binders and occurrences]
       ; Core (M Dec)
dec  <- LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addQTyVarBinds LHsQTyVars GhcRn
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
 -> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
           do { Core (M Cxt)
cxt1   <- LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
cxt
          -- See Note [Scoped type variables in quotes]
              ; ([GenSymBind]
ss, [Core (M Dec)]
sigs_binds) <- [LSig GhcRn]
-> LHsBindsLR GhcRn GhcRn -> MetaM ([GenSymBind], [Core (M Dec)])
rep_meth_sigs_binds [LSig GhcRn]
sigs LHsBindsLR GhcRn GhcRn
meth_binds
              ; Core [FunDep]
fds1   <- [LHsFunDep GhcRn] -> MetaM (Core [FunDep])
repLFunDeps [LHsFunDep GhcRn]
fds
              ; [Core (M Dec)]
ats1   <- [LFamilyDecl GhcRn] -> MetaM [Core (M Dec)]
repFamilyDecls [LFamilyDecl GhcRn]
ats
              ; [Core (M Dec)]
atds1  <- (LTyFamDefltDecl GhcRn -> MetaM (Core (M Dec)))
-> [LTyFamDefltDecl GhcRn] -> MetaM [Core (M Dec)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TyFamDefltDecl GhcRn -> MetaM (Core (M Dec))
repAssocTyFamDefaultD (TyFamDefltDecl GhcRn -> MetaM (Core (M Dec)))
-> (LTyFamDefltDecl GhcRn -> TyFamDefltDecl GhcRn)
-> LTyFamDefltDecl GhcRn
-> MetaM (Core (M Dec))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTyFamDefltDecl GhcRn -> TyFamDefltDecl GhcRn
forall l e. GenLocated l e -> e
unLoc) [LTyFamDefltDecl GhcRn]
atds
              ; Core [M Dec]
decls1 <- Name
-> (Core (M Dec) -> MetaM (Core (M Dec)))
-> [Core (M Dec)]
-> MetaM (Core [M Dec])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
decTyConName Core (M Dec) -> MetaM (Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Core (M Dec)]
ats1 [Core (M Dec)] -> [Core (M Dec)] -> [Core (M Dec)]
forall a. [a] -> [a] -> [a]
++ [Core (M Dec)]
atds1 [Core (M Dec)] -> [Core (M Dec)] -> [Core (M Dec)]
forall a. [a] -> [a] -> [a]
++ [Core (M Dec)]
sigs_binds)
              ; Core (M Dec)
decls2 <- Core (M Cxt)
-> Core Name
-> Core [M (TyVarBndr ())]
-> Core [FunDep]
-> Core [M Dec]
-> MetaM (Core (M Dec))
repClass Core (M Cxt)
cxt1 Core Name
cls1 Core [M (TyVarBndr ())]
bndrs Core [FunDep]
fds1 Core [M Dec]
decls1
              ; [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
decls2 }
       ; Maybe (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SrcSpan, Core (M Dec))
 -> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec))))
-> Maybe (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (Maybe (SrcSpan, Core (M Dec)))
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Core (M Dec)) -> Maybe (SrcSpan, Core (M Dec))
forall a. a -> Maybe a
Just (SrcSpan
loc, Core (M Dec)
dec)
       }

-------------------------
repRoleD :: LRoleAnnotDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repRoleD :: LRoleAnnotDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRoleD (L SrcSpan
loc (RoleAnnotDecl XCRoleAnnotDecl GhcRn
_ Located (IdP GhcRn)
tycon [Located (Maybe Role)]
roles))
  = do { Core Name
tycon1 <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
tycon
       ; [Core Role]
roles1 <- (Located (Maybe Role) -> ReaderT MetaWrappers DsM (Core Role))
-> [Located (Maybe Role)] -> ReaderT MetaWrappers DsM [Core Role]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located (Maybe Role) -> ReaderT MetaWrappers DsM (Core Role)
repRole [Located (Maybe Role)]
roles
       ; Core [Role]
roles2 <- Name -> [Core Role] -> MetaM (Core [Role])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreList Name
roleTyConName [Core Role]
roles1
       ; Core (M Dec)
dec <- Core Name -> Core [Role] -> MetaM (Core (M Dec))
repRoleAnnotD Core Name
tycon1 Core [Role]
roles2
       ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
dec) }

-------------------------
repKiSigD :: LStandaloneKindSig GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repKiSigD :: LStandaloneKindSig GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repKiSigD (L SrcSpan
loc StandaloneKindSig GhcRn
kisig) =
  case StandaloneKindSig GhcRn
kisig of
    StandaloneKindSig XStandaloneKindSig GhcRn
_ Located (IdP GhcRn)
v LHsSigType GhcRn
ki -> Name
-> SrcSpan
-> LHsSigType GhcRn
-> Located Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
kiSigDName SrcSpan
loc LHsSigType GhcRn
ki Located Name
Located (IdP GhcRn)
v

-------------------------
repDataDefn :: Core TH.Name
            -> Either (Core [(M (TH.TyVarBndr ()))])
                        -- 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 ())])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> HsDataDefn GhcRn
-> MetaM (Core (M Dec))
repDataDefn Core Name
tc Either
  (Core [M (TyVarBndr ())])
  (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
opts
          (HsDataDefn { dd_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_ND = NewOrData
new_or_data, dd_ctxt :: forall pass. HsDataDefn pass -> LHsContext pass
dd_ctxt = LHsContext GhcRn
cxt, dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (LHsType GhcRn)
ksig
                      , dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons = [LConDecl GhcRn]
cons, dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs = HsDeriving GhcRn
mb_derivs })
  = do { Core (M Cxt)
cxt1     <- LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
cxt
       ; Core [M DerivClause]
derivs1  <- HsDeriving GhcRn -> MetaM (Core [M DerivClause])
repDerivs HsDeriving GhcRn
mb_derivs
       ; case (NewOrData
new_or_data, [LConDecl GhcRn]
cons) of
           (NewOrData
NewType, [LConDecl GhcRn
con])  -> do { Core (M Con)
con'  <- LConDecl GhcRn -> MetaM (Core (M Con))
repC LConDecl GhcRn
con
                                   ; Core (Maybe (M Type))
ksig' <- Maybe (LHsType GhcRn) -> MetaM (Core (Maybe (M Type)))
repMaybeLTy Maybe (LHsType GhcRn)
ksig
                                   ; Core (M Cxt)
-> Core Name
-> Either
     (Core [M (TyVarBndr ())])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Core (Maybe (M Type))
-> Core (M Con)
-> Core [M DerivClause]
-> MetaM (Core (M Dec))
repNewtype Core (M Cxt)
cxt1 Core Name
tc Either
  (Core [M (TyVarBndr ())])
  (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
opts Core (Maybe (M Type))
ksig' Core (M Con)
con'
                                                Core [M DerivClause]
derivs1 }
           (NewOrData
NewType, [LConDecl GhcRn]
_) -> IOEnv (Env DsGblEnv DsLclEnv) (Core (M Dec))
-> MetaM (Core (M Dec))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env DsGblEnv DsLclEnv) (Core (M Dec))
 -> MetaM (Core (M Dec)))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core (M Dec))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ SDoc -> IOEnv (Env DsGblEnv DsLclEnv) (Core (M Dec))
forall a. SDoc -> DsM a
failWithDs (String -> SDoc
text String
"Multiple constructors for newtype:"
                                       SDoc -> SDoc -> SDoc
<+> [Located Name] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList
                                       (ConDecl GhcRn -> [Located Name]
getConNames (ConDecl GhcRn -> [Located Name])
-> ConDecl GhcRn -> [Located Name]
forall a b. (a -> b) -> a -> b
$ LConDecl GhcRn -> ConDecl GhcRn
forall l e. GenLocated l e -> e
unLoc (LConDecl GhcRn -> ConDecl GhcRn)
-> LConDecl GhcRn -> ConDecl GhcRn
forall a b. (a -> b) -> a -> b
$ [LConDecl GhcRn] -> LConDecl GhcRn
forall a. [a] -> a
head [LConDecl GhcRn]
cons))
           (NewOrData
DataType, [LConDecl GhcRn]
_) -> do { Core (Maybe (M Type))
ksig' <- Maybe (LHsType GhcRn) -> MetaM (Core (Maybe (M Type)))
repMaybeLTy Maybe (LHsType GhcRn)
ksig
                               ; [Core (M Con)]
consL <- (LConDecl GhcRn -> MetaM (Core (M Con)))
-> [LConDecl GhcRn] -> ReaderT MetaWrappers DsM [Core (M Con)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LConDecl GhcRn -> MetaM (Core (M Con))
repC [LConDecl GhcRn]
cons
                               ; Core [M Con]
cons1 <- Name -> [Core (M Con)] -> MetaM (Core [M Con])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
conTyConName [Core (M Con)]
consL
                               ; Core (M Cxt)
-> Core Name
-> Either
     (Core [M (TyVarBndr ())])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Core (Maybe (M Type))
-> Core [M Con]
-> Core [M DerivClause]
-> MetaM (Core (M Dec))
repData Core (M Cxt)
cxt1 Core Name
tc Either
  (Core [M (TyVarBndr ())])
  (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
opts Core (Maybe (M Type))
ksig' Core [M Con]
cons1
                                         Core [M DerivClause]
derivs1 }
       }

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

repFamilyDecl :: LFamilyDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repFamilyDecl :: LFamilyDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repFamilyDecl decl :: LFamilyDecl GhcRn
decl@(L SrcSpan
loc (FamilyDecl { fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo      = FamilyInfo GhcRn
info
                                      , fdLName :: forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName     = Located (IdP GhcRn)
tc
                                      , fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars    = LHsQTyVars GhcRn
tvs
                                      , fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdResultSig = L SrcSpan
_ FamilyResultSig GhcRn
resultSig
                                      , fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn GhcRn)
injectivity }))
  = do { Core Name
tc1 <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
tc           -- See note [Binders and occurrences]
       ; let mkHsQTvs :: [LHsTyVarBndr () GhcRn] -> LHsQTyVars GhcRn
             mkHsQTvs :: [LHsTyVarBndr () GhcRn] -> LHsQTyVars GhcRn
mkHsQTvs [LHsTyVarBndr () GhcRn]
tvs = HsQTvs :: forall pass.
XHsQTvs pass -> [LHsTyVarBndr () pass] -> LHsQTyVars pass
HsQTvs { hsq_ext :: XHsQTvs GhcRn
hsq_ext = []
                                   , hsq_explicit :: [LHsTyVarBndr () GhcRn]
hsq_explicit = [LHsTyVarBndr () GhcRn]
tvs }
             resTyVar :: LHsQTyVars GhcRn
resTyVar = case FamilyResultSig GhcRn
resultSig of
                     TyVarSig XTyVarSig GhcRn
_ LHsTyVarBndr () GhcRn
bndr -> [LHsTyVarBndr () GhcRn] -> LHsQTyVars GhcRn
mkHsQTvs [LHsTyVarBndr () GhcRn
bndr]
                     FamilyResultSig GhcRn
_               -> [LHsTyVarBndr () GhcRn] -> LHsQTyVars GhcRn
mkHsQTvs []
       ; Core (M Dec)
dec <- LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyClTyVarBinds LHsQTyVars GhcRn
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
 -> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
                LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyClTyVarBinds LHsQTyVars GhcRn
resTyVar ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
 -> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
_ ->
           case FamilyInfo GhcRn
info of
             ClosedTypeFamily Maybe [LTyFamInstEqn GhcRn]
Nothing ->
                 String -> SDoc -> MetaM (Core (M Dec))
forall a. String -> SDoc -> MetaM a
notHandled String
"abstract closed type family" (LFamilyDecl GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr LFamilyDecl GhcRn
decl)
             ClosedTypeFamily (Just [LTyFamInstEqn GhcRn]
eqns) ->
               do { [Core (M TySynEqn)]
eqns1  <- (LTyFamInstEqn GhcRn
 -> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> [LTyFamInstEqn GhcRn]
-> ReaderT MetaWrappers DsM [Core (M TySynEqn)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TyFamInstEqn GhcRn -> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTyFamEqn (TyFamInstEqn GhcRn
 -> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> (LTyFamInstEqn GhcRn -> TyFamInstEqn GhcRn)
-> LTyFamInstEqn GhcRn
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTyFamInstEqn GhcRn -> TyFamInstEqn GhcRn
forall l e. GenLocated l e -> e
unLoc) [LTyFamInstEqn GhcRn]
eqns
                  ; Core [M TySynEqn]
eqns2  <- Name -> [Core (M TySynEqn)] -> MetaM (Core [M TySynEqn])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
tySynEqnTyConName [Core (M TySynEqn)]
eqns1
                  ; Core (M FamilyResultSig)
result <- FamilyResultSig GhcRn -> MetaM (Core (M FamilyResultSig))
repFamilyResultSig FamilyResultSig GhcRn
resultSig
                  ; Core (Maybe InjectivityAnn)
inj    <- Maybe (LInjectivityAnn GhcRn)
-> MetaM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn GhcRn)
injectivity
                  ; Core Name
-> Core [M (TyVarBndr ())]
-> Core (M FamilyResultSig)
-> Core (Maybe InjectivityAnn)
-> Core [M TySynEqn]
-> MetaM (Core (M Dec))
repClosedFamilyD Core Name
tc1 Core [M (TyVarBndr ())]
bndrs Core (M FamilyResultSig)
result Core (Maybe InjectivityAnn)
inj Core [M TySynEqn]
eqns2 }
             FamilyInfo GhcRn
OpenTypeFamily ->
               do { Core (M FamilyResultSig)
result <- FamilyResultSig GhcRn -> MetaM (Core (M FamilyResultSig))
repFamilyResultSig FamilyResultSig GhcRn
resultSig
                  ; Core (Maybe InjectivityAnn)
inj    <- Maybe (LInjectivityAnn GhcRn)
-> MetaM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn GhcRn)
injectivity
                  ; Core Name
-> Core [M (TyVarBndr ())]
-> Core (M FamilyResultSig)
-> Core (Maybe InjectivityAnn)
-> MetaM (Core (M Dec))
repOpenFamilyD Core Name
tc1 Core [M (TyVarBndr ())]
bndrs Core (M FamilyResultSig)
result Core (Maybe InjectivityAnn)
inj }
             FamilyInfo GhcRn
DataFamily ->
               do { Core (Maybe (M Type))
kind <- FamilyResultSig GhcRn -> MetaM (Core (Maybe (M Type)))
repFamilyResultSigToMaybeKind FamilyResultSig GhcRn
resultSig
                  ; Core Name
-> Core [M (TyVarBndr ())]
-> Core (Maybe (M Type))
-> MetaM (Core (M Dec))
repDataFamilyD Core Name
tc1 Core [M (TyVarBndr ())]
bndrs Core (Maybe (M Type))
kind }
       ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
dec)
       }

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

-- | 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 GhcRn -> MetaM (Core (Maybe (M Type)))
repFamilyResultSigToMaybeKind (NoSig XNoSig GhcRn
_) =
    do { Name -> MetaM (Core (Maybe (M Type)))
forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
kindTyConName }
repFamilyResultSigToMaybeKind (KindSig XCKindSig GhcRn
_ LHsType GhcRn
ki) =
    do { 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 GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ki }
repFamilyResultSigToMaybeKind TyVarSig{} =
    String -> MetaM (Core (Maybe (M Type)))
forall a. 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 GhcRn)
-> MetaM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn GhcRn)
Nothing =
    do { Name -> MetaM (Core (Maybe InjectivityAnn))
forall a. Name -> MetaM (Core (Maybe a))
coreNothing Name
injAnnTyConName }
repInjectivityAnn (Just (L SrcSpan
_ (InjectivityAnn Located (IdP GhcRn)
lhs [Located (IdP GhcRn)]
rhs))) =
    do { Core Name
lhs'   <- Name -> MetaM (Core Name)
lookupBinder (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
Located (IdP GhcRn)
lhs)
       ; [Core Name]
rhs1   <- (Located Name -> MetaM (Core Name))
-> [Located Name] -> ReaderT MetaWrappers DsM [Core Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name -> MetaM (Core Name)
lookupBinder (Name -> MetaM (Core Name))
-> (Located Name -> Name) -> Located Name -> MetaM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Name -> Name
forall l e. GenLocated l e -> e
unLoc) [Located Name]
[Located (IdP GhcRn)]
rhs
       ; Core [Name]
rhs2   <- Name -> [Core Name] -> MetaM (Core [Name])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreList Name
nameTyConName [Core Name]
rhs1
       ; Core InjectivityAnn
injAnn <- Name -> [CoreExpr] -> MetaM (Core InjectivityAnn)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
injectivityAnnName [Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC Core Name
lhs', Core [Name] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [Name]
rhs2]
       ; Name -> Core InjectivityAnn -> MetaM (Core (Maybe InjectivityAnn))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJust Name
injAnnTyConName Core InjectivityAnn
injAnn }

repFamilyDecls :: [LFamilyDecl GhcRn] -> MetaM [Core (M TH.Dec)]
repFamilyDecls :: [LFamilyDecl GhcRn] -> MetaM [Core (M Dec)]
repFamilyDecls [LFamilyDecl GhcRn]
fds = ([(SrcSpan, Core (M Dec))] -> [Core (M Dec)])
-> MetaM [(SrcSpan, Core (M Dec))] -> MetaM [Core (M Dec)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ((LFamilyDecl GhcRn
 -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [LFamilyDecl GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LFamilyDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repFamilyDecl [LFamilyDecl GhcRn]
fds)

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

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

repLFunDep :: LHsFunDep GhcRn -> MetaM (Core TH.FunDep)
repLFunDep :: LHsFunDep GhcRn -> MetaM (Core FunDep)
repLFunDep (L SrcSpan
_ ([Located (IdP GhcRn)]
xs, [Located (IdP GhcRn)]
ys))
   = do Core [Name]
xs' <- Name
-> (Located Name -> MetaM (Core Name))
-> [Located 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))
-> (Located Name -> Name) -> Located Name -> MetaM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Name -> Name
forall l e. GenLocated l e -> e
unLoc) [Located Name]
[Located (IdP GhcRn)]
xs
        Core [Name]
ys' <- Name
-> (Located Name -> MetaM (Core Name))
-> [Located 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))
-> (Located Name -> Name) -> Located Name -> MetaM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Name -> Name
forall l e. GenLocated l e -> e
unLoc) [Located Name]
[Located (IdP GhcRn)]
ys
        Core [Name] -> Core [Name] -> MetaM (Core FunDep)
repFunDep Core [Name]
xs' Core [Name]
ys'

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

repClsInstD :: ClsInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repClsInstD :: ClsInstDecl GhcRn -> MetaM (Core (M Dec))
repClsInstD (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = LHsSigType GhcRn
ty, cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds = LHsBindsLR GhcRn GhcRn
binds
                         , cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_sigs = [LSig GhcRn]
sigs, cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts = [LTyFamDefltDecl GhcRn]
ats
                         , cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts = [LDataFamInstDecl GhcRn]
adts
                         , cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (Located OverlapMode)
cid_overlap_mode = Maybe (Located OverlapMode)
overlap
                         })
  = [Name] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a. [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds [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 { Core (M Cxt)
cxt1     <- LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
cxt
               ; Core (M Type)
inst_ty1 <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
inst_ty
          -- See Note [Scoped type variables in quotes]
               ; ([GenSymBind]
ss, [Core (M Dec)]
sigs_binds) <- [LSig GhcRn]
-> LHsBindsLR GhcRn GhcRn -> MetaM ([GenSymBind], [Core (M Dec)])
rep_meth_sigs_binds [LSig GhcRn]
sigs LHsBindsLR GhcRn GhcRn
binds
               ; [Core (M Dec)]
ats1   <- (LTyFamDefltDecl GhcRn -> MetaM (Core (M Dec)))
-> [LTyFamDefltDecl GhcRn] -> MetaM [Core (M Dec)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TyFamDefltDecl GhcRn -> MetaM (Core (M Dec))
repTyFamInstD (TyFamDefltDecl GhcRn -> MetaM (Core (M Dec)))
-> (LTyFamDefltDecl GhcRn -> TyFamDefltDecl GhcRn)
-> LTyFamDefltDecl GhcRn
-> MetaM (Core (M Dec))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTyFamDefltDecl GhcRn -> TyFamDefltDecl GhcRn
forall l e. GenLocated l e -> e
unLoc) [LTyFamDefltDecl GhcRn]
ats
               ; [Core (M Dec)]
adts1  <- (LDataFamInstDecl GhcRn -> MetaM (Core (M Dec)))
-> [LDataFamInstDecl GhcRn] -> MetaM [Core (M Dec)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DataFamInstDecl GhcRn -> MetaM (Core (M Dec))
repDataFamInstD (DataFamInstDecl GhcRn -> MetaM (Core (M Dec)))
-> (LDataFamInstDecl GhcRn -> DataFamInstDecl GhcRn)
-> LDataFamInstDecl GhcRn
-> MetaM (Core (M Dec))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDataFamInstDecl GhcRn -> DataFamInstDecl GhcRn
forall l e. GenLocated l e -> e
unLoc) [LDataFamInstDecl GhcRn]
adts
               ; Core [M Dec]
decls1 <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName ([Core (M Dec)]
ats1 [Core (M Dec)] -> [Core (M Dec)] -> [Core (M Dec)]
forall a. [a] -> [a] -> [a]
++ [Core (M Dec)]
adts1 [Core (M Dec)] -> [Core (M Dec)] -> [Core (M Dec)]
forall a. [a] -> [a] -> [a]
++ [Core (M Dec)]
sigs_binds)
               ; Core (Maybe Overlap)
rOver  <- Maybe OverlapMode -> MetaM (Core (Maybe Overlap))
repOverlap ((Located OverlapMode -> OverlapMode)
-> Maybe (Located OverlapMode) -> Maybe OverlapMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located OverlapMode -> OverlapMode
forall l e. GenLocated l e -> e
unLoc Maybe (Located OverlapMode)
overlap)
               ; Core (M Dec)
decls2 <- Core (Maybe Overlap)
-> Core (M Cxt)
-> Core (M Type)
-> Core [M Dec]
-> MetaM (Core (M Dec))
repInst Core (Maybe Overlap)
rOver Core (M Cxt)
cxt1 Core (M Type)
inst_ty1 Core [M Dec]
decls1
               ; [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
decls2 }
 where
   ([Name]
tvs, LHsContext GhcRn
cxt, LHsType GhcRn
inst_ty) = LHsSigType GhcRn -> ([Name], LHsContext GhcRn, LHsType GhcRn)
splitLHsInstDeclTy LHsSigType GhcRn
ty

repStandaloneDerivD :: LDerivDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repStandaloneDerivD :: LDerivDecl GhcRn
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repStandaloneDerivD (L SrcSpan
loc (DerivDecl { deriv_strategy :: forall pass. DerivDecl pass -> Maybe (LDerivStrategy pass)
deriv_strategy = Maybe (LDerivStrategy GhcRn)
strat
                                       , deriv_type :: forall pass. DerivDecl pass -> LHsSigWcType pass
deriv_type     = LHsSigWcType GhcRn
ty }))
  = do { Core (M Dec)
dec <- Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy Maybe (LDerivStrategy GhcRn)
strat  ((Core (Maybe (M DerivStrategy)) -> MetaM (Core (M Dec)))
 -> MetaM (Core (M Dec)))
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \Core (Maybe (M DerivStrategy))
strat' ->
                [Name] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a. [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds [Name]
tvs (MetaM (Core (M Dec)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$
                do { Core (M Cxt)
cxt'     <- LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
cxt
                   ; Core (M Type)
inst_ty' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
inst_ty
                   ; Core (Maybe (M DerivStrategy))
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Dec))
repDeriv Core (Maybe (M DerivStrategy))
strat' Core (M Cxt)
cxt' Core (M Type)
inst_ty' }
       ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
dec) }
  where
    ([Name]
tvs, LHsContext GhcRn
cxt, LHsType GhcRn
inst_ty) = LHsSigType GhcRn -> ([Name], LHsContext GhcRn, LHsType GhcRn)
splitLHsInstDeclTy (LHsSigWcType GhcRn -> LHsSigType GhcRn
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType GhcRn
ty)

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

repTyFamEqn :: TyFamInstEqn GhcRn -> MetaM (Core (M TH.TySynEqn))
repTyFamEqn :: TyFamInstEqn GhcRn -> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTyFamEqn (HsIB { hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
hsib_ext = XHsIB GhcRn (FamEqn GhcRn (LHsType GhcRn))
var_names
                  , hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = Located (IdP GhcRn)
tc_name
                                       , feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> Maybe [LHsTyVarBndr () pass]
feqn_bndrs = Maybe [LHsTyVarBndr () GhcRn]
mb_bndrs
                                       , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats = HsTyPats GhcRn
tys
                                       , feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_fixity = LexicalFixity
fixity
                                       , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs  = LHsType GhcRn
rhs }})
  = do { Core Name
tc <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
tc_name     -- See note [Binders and occurrences]
       ; let hs_tvs :: LHsQTyVars GhcRn
hs_tvs = HsQTvs :: forall pass.
XHsQTvs pass -> [LHsTyVarBndr () pass] -> LHsQTyVars pass
HsQTvs { hsq_ext :: XHsQTvs GhcRn
hsq_ext = XHsIB GhcRn (FamEqn GhcRn (LHsType GhcRn))
XHsQTvs GhcRn
var_names
                             , hsq_explicit :: [LHsTyVarBndr () GhcRn]
hsq_explicit = [LHsTyVarBndr () GhcRn]
-> Maybe [LHsTyVarBndr () GhcRn] -> [LHsTyVarBndr () GhcRn]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LHsTyVarBndr () GhcRn]
mb_bndrs }
       ; LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())]
    -> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
forall a.
LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyClTyVarBinds LHsQTyVars GhcRn
hs_tvs ((Core [M (TyVarBndr ())]
  -> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
 -> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> (Core [M (TyVarBndr ())]
    -> ReaderT MetaWrappers DsM (Core (M TySynEqn)))
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
forall a b. (a -> b) -> a -> b
$ \ Core [M (TyVarBndr ())]
_ ->
         do { Core (Maybe [M (TyVarBndr ())])
mb_bndrs1 <- Name
-> (LHsTyVarBndr () GhcRn -> MetaM (Core (M (TyVarBndr ()))))
-> Maybe [LHsTyVarBndr () GhcRn]
-> MetaM (Core (Maybe [M (TyVarBndr ())]))
forall a b.
Name
-> (a -> MetaM (Core b)) -> Maybe [a] -> MetaM (Core (Maybe [b]))
repMaybeListM Name
tyVarBndrUnitTyConName
                                        LHsTyVarBndr () GhcRn -> MetaM (Core (M (TyVarBndr ())))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr
                                        Maybe [LHsTyVarBndr () GhcRn]
mb_bndrs
            ; Core (M Type)
tys1 <- case LexicalFixity
fixity of
                        LexicalFixity
Prefix -> MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core Name -> MetaM (Core (M Type))
repNamedTyCon Core Name
tc) HsTyPats GhcRn
tys
                        LexicalFixity
Infix  -> do { (HsValArg LHsType GhcRn
t1: HsValArg LHsType GhcRn
t2: HsTyPats GhcRn
args) <- HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
checkTys HsTyPats GhcRn
tys
                                     ; Core (M Type)
t1' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
t1
                                     ; Core (M Type)
t2'  <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
t2
                                     ; MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core (M Type)
-> Core Name -> Core (M Type) -> MetaM (Core (M Type))
repTInfix Core (M Type)
t1' Core Name
tc Core (M Type)
t2') HsTyPats GhcRn
args }
            ; Core (M Type)
rhs1 <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
rhs
            ; Core (Maybe [M (TyVarBndr ())])
-> Core (M Type)
-> Core (M Type)
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTySynEqn Core (Maybe [M (TyVarBndr ())])
mb_bndrs1 Core (M Type)
tys1 Core (M Type)
rhs1 } }
     where checkTys :: [LHsTypeArg GhcRn] -> MetaM [LHsTypeArg GhcRn]
           checkTys :: HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
checkTys tys :: HsTyPats GhcRn
tys@(HsValArg LHsType GhcRn
_:HsValArg LHsType GhcRn
_:HsTyPats GhcRn
_) = HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return HsTyPats GhcRn
tys
           checkTys HsTyPats GhcRn
_ = String -> MetaM (HsTyPats GhcRn)
forall a. String -> a
panic String
"repTyFamEqn:checkTys"

repTyArgs :: MetaM (Core (M TH.Type)) -> [LHsTypeArg GhcRn] -> MetaM (Core (M TH.Type))
repTyArgs :: MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs MetaM (Core (M Type))
f [] = MetaM (Core (M Type))
f
repTyArgs MetaM (Core (M Type))
f (HsValArg LHsType GhcRn
ty : HsTyPats GhcRn
as) = do { Core (M Type)
f' <- MetaM (Core (M Type))
f
                                    ; Core (M Type)
ty' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ty
                                    ; MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
f' Core (M Type)
ty') HsTyPats GhcRn
as }
repTyArgs MetaM (Core (M Type))
f (HsTypeArg SrcSpan
_ LHsType GhcRn
ki : HsTyPats GhcRn
as) = do { Core (M Type)
f' <- MetaM (Core (M Type))
f
                                       ; Core (M Type)
ki' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ki
                                       ; MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTappKind Core (M Type)
f' Core (M Type)
ki') HsTyPats GhcRn
as }
repTyArgs MetaM (Core (M Type))
f (HsArgPar SrcSpan
_ : HsTyPats GhcRn
as) = MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs MetaM (Core (M Type))
f HsTyPats GhcRn
as

repDataFamInstD :: DataFamInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repDataFamInstD :: DataFamInstDecl GhcRn -> MetaM (Core (M Dec))
repDataFamInstD (DataFamInstDecl { dfid_eqn :: forall pass.
DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
dfid_eqn =
                  (HsIB { hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
hsib_ext = XHsIB GhcRn (FamEqn GhcRn (HsDataDefn GhcRn))
var_names
                        , hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = Located (IdP GhcRn)
tc_name
                                             , feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> Maybe [LHsTyVarBndr () pass]
feqn_bndrs = Maybe [LHsTyVarBndr () GhcRn]
mb_bndrs
                                             , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats  = HsTyPats GhcRn
tys
                                             , feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_fixity = LexicalFixity
fixity
                                             , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs   = HsDataDefn GhcRn
defn }})})
  = do { Core Name
tc <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
tc_name         -- See note [Binders and occurrences]
       ; let hs_tvs :: LHsQTyVars GhcRn
hs_tvs = HsQTvs :: forall pass.
XHsQTvs pass -> [LHsTyVarBndr () pass] -> LHsQTyVars pass
HsQTvs { hsq_ext :: XHsQTvs GhcRn
hsq_ext = XHsIB GhcRn (FamEqn GhcRn (HsDataDefn GhcRn))
XHsQTvs GhcRn
var_names
                             , hsq_explicit :: [LHsTyVarBndr () GhcRn]
hsq_explicit = [LHsTyVarBndr () GhcRn]
-> Maybe [LHsTyVarBndr () GhcRn] -> [LHsTyVarBndr () GhcRn]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LHsTyVarBndr () GhcRn]
mb_bndrs }
       ; LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a.
LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyClTyVarBinds LHsQTyVars GhcRn
hs_tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
 -> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \ Core [M (TyVarBndr ())]
_ ->
         do { Core (Maybe [M (TyVarBndr ())])
mb_bndrs1 <- Name
-> (LHsTyVarBndr () GhcRn -> MetaM (Core (M (TyVarBndr ()))))
-> Maybe [LHsTyVarBndr () GhcRn]
-> MetaM (Core (Maybe [M (TyVarBndr ())]))
forall a b.
Name
-> (a -> MetaM (Core b)) -> Maybe [a] -> MetaM (Core (Maybe [b]))
repMaybeListM Name
tyVarBndrUnitTyConName
                                        LHsTyVarBndr () GhcRn -> MetaM (Core (M (TyVarBndr ())))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr
                                        Maybe [LHsTyVarBndr () GhcRn]
mb_bndrs
            ; Core (M Type)
tys1 <- case LexicalFixity
fixity of
                        LexicalFixity
Prefix -> MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core Name -> MetaM (Core (M Type))
repNamedTyCon Core Name
tc) HsTyPats GhcRn
tys
                        LexicalFixity
Infix  -> do { (HsValArg LHsType GhcRn
t1: HsValArg LHsType GhcRn
t2: HsTyPats GhcRn
args) <- HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
checkTys HsTyPats GhcRn
tys
                                     ; Core (M Type)
t1' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
t1
                                     ; Core (M Type)
t2'  <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
t2
                                     ; MetaM (Core (M Type)) -> HsTyPats GhcRn -> MetaM (Core (M Type))
repTyArgs (Core (M Type)
-> Core Name -> Core (M Type) -> MetaM (Core (M Type))
repTInfix Core (M Type)
t1' Core Name
tc Core (M Type)
t2') HsTyPats GhcRn
args }
            ; Core Name
-> Either
     (Core [M (TyVarBndr ())])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> HsDataDefn GhcRn
-> MetaM (Core (M Dec))
repDataDefn Core Name
tc ((Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Either
     (Core [M (TyVarBndr ())])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
forall a b. b -> Either a b
Right (Core (Maybe [M (TyVarBndr ())])
mb_bndrs1, Core (M Type)
tys1)) HsDataDefn GhcRn
defn } }

      where checkTys :: [LHsTypeArg GhcRn] -> MetaM [LHsTypeArg GhcRn]
            checkTys :: HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
checkTys tys :: HsTyPats GhcRn
tys@(HsValArg LHsType GhcRn
_: HsValArg LHsType GhcRn
_: HsTyPats GhcRn
_) = HsTyPats GhcRn -> MetaM (HsTyPats GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return HsTyPats GhcRn
tys
            checkTys HsTyPats GhcRn
_ = String -> MetaM (HsTyPats GhcRn)
forall a. String -> a
panic String
"repDataFamInstD:checkTys"

repForD :: Located (ForeignDecl GhcRn) -> MetaM (SrcSpan, Core (M TH.Dec))
repForD :: Located (ForeignDecl GhcRn)
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repForD (L SrcSpan
loc (ForeignImport { fd_name :: forall pass. ForeignDecl pass -> Located (IdP pass)
fd_name = Located (IdP GhcRn)
name, fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty = LHsSigType GhcRn
typ
                                  , fd_fi :: forall pass. ForeignDecl pass -> ForeignImport
fd_fi = CImport (L SrcSpan
_ CCallConv
cc)
                                                    (L SrcSpan
_ Safety
s) Maybe Header
mch CImportSpec
cis Located SourceText
_ }))
 = do MkC CoreExpr
name' <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
name
      MkC CoreExpr
typ' <- LHsSigType GhcRn -> MetaM (Core (M Type))
repHsSigType LHsSigType GhcRn
typ
      MkC CoreExpr
cc' <- CCallConv -> MetaM (Core Callconv)
repCCallConv CCallConv
cc
      MkC CoreExpr
s' <- Safety -> MetaM (Core Safety)
repSafety Safety
s
      String
cis' <- CImportSpec -> MetaM String
conv_cimportspec CImportSpec
cis
      MkC CoreExpr
str <- String -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit (String
static String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
chStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cis')
      Core (M Dec)
dec <- Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forImpDName [CoreExpr
cc', CoreExpr
s', CoreExpr
str, CoreExpr
name', CoreExpr
typ']
      (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
dec)
 where
    conv_cimportspec :: CImportSpec -> MetaM String
conv_cimportspec (CLabel CLabelString
cls)
      = String -> SDoc -> MetaM String
forall a. String -> SDoc -> MetaM a
notHandled String
"Foreign label" (SDoc -> SDoc
doubleQuotes (CLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabelString
cls))
    conv_cimportspec (CFunction CCallTarget
DynamicTarget) = String -> MetaM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"dynamic"
    conv_cimportspec (CFunction (StaticTarget SourceText
_ CLabelString
fs Maybe Unit
_ Bool
True))
                            = String -> MetaM String
forall (m :: * -> *) a. Monad m => a -> m a
return (CLabelString -> String
unpackFS CLabelString
fs)
    conv_cimportspec (CFunction (StaticTarget SourceText
_ CLabelString
_  Maybe Unit
_ Bool
False))
                            = String -> MetaM String
forall a. String -> a
panic String
"conv_cimportspec: values not supported yet"
    conv_cimportspec CImportSpec
CWrapper = String -> MetaM String
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
_ CLabelString
_ Maybe Unit
_ Bool
_) | Bool -> Bool
not Bool
raw_cconv -> String
"static "
                 CImportSpec
_ -> String
""
    chStr :: String
chStr = case Maybe Header
mch of
            Just (Header SourceText
_ CLabelString
h) | Bool -> Bool
not Bool
raw_cconv -> CLabelString -> String
unpackFS CLabelString
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
            Maybe Header
_ -> String
""
repForD decl :: Located (ForeignDecl GhcRn)
decl@(L SrcSpan
_ ForeignExport{}) = String -> SDoc -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. String -> SDoc -> MetaM a
notHandled String
"Foreign export" (Located (ForeignDecl GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (ForeignDecl GhcRn)
decl)

repCCallConv :: CCallConv -> MetaM (Core TH.Callconv)
repCCallConv :: CCallConv -> MetaM (Core Callconv)
repCCallConv CCallConv
CCallConv          = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
cCallName []
repCCallConv CCallConv
StdCallConv        = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
stdCallName []
repCCallConv CCallConv
CApiConv           = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
cApiCallName []
repCCallConv CCallConv
PrimCallConv       = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
primCallName []
repCCallConv CCallConv
JavaScriptCallConv = Name -> [CoreExpr] -> MetaM (Core Callconv)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
javaScriptCallName []

repSafety :: Safety -> MetaM (Core TH.Safety)
repSafety :: Safety -> MetaM (Core Safety)
repSafety Safety
PlayRisky = Name -> [CoreExpr] -> MetaM (Core Safety)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
unsafeName []
repSafety Safety
PlayInterruptible = Name -> [CoreExpr] -> MetaM (Core Safety)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
interruptibleName []
repSafety Safety
PlaySafe = Name -> [CoreExpr] -> MetaM (Core Safety)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
safeName []

repLFixD :: LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
repLFixD :: LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
repLFixD (L SrcSpan
loc FixitySig GhcRn
fix_sig) = SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_fix_d SrcSpan
loc FixitySig GhcRn
fix_sig

rep_fix_d :: SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_fix_d :: SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_fix_d SrcSpan
loc (FixitySig XFixitySig GhcRn
_ [Located (IdP GhcRn)]
names (Fixity SourceText
_ Int
prec FixityDirection
dir))
  = do { MkC CoreExpr
prec' <- Int -> MetaM (Core Int)
coreIntLit Int
prec
       ; let rep_fn :: Name
rep_fn = case FixityDirection
dir of
                        FixityDirection
InfixL -> Name
infixLDName
                        FixityDirection
InfixR -> Name
infixRDName
                        FixityDirection
InfixN -> Name
infixNDName
       ; let do_one :: Located Name -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
do_one Located Name
name
              = do { MkC CoreExpr
name' <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
name
                   ; Core (M Dec)
dec <- Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
rep_fn [CoreExpr
prec', CoreExpr
name']
                   ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc,Core (M Dec)
dec) }
       ; (Located Name -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [Located Name] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located Name -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
do_one [Located Name]
[Located (IdP GhcRn)]
names }

repRuleD :: LRuleDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repRuleD :: LRuleDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repRuleD (L SrcSpan
loc (HsRule { rd_name :: forall pass. RuleDecl pass -> Located (SourceText, CLabelString)
rd_name = Located (SourceText, CLabelString)
n
                        , rd_act :: forall pass. RuleDecl pass -> Activation
rd_act = Activation
act
                        , rd_tyvs :: forall pass.
RuleDecl pass -> Maybe [LHsTyVarBndr () (NoGhcTc pass)]
rd_tyvs = Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
ty_bndrs
                        , rd_tmvs :: forall pass. RuleDecl pass -> [LRuleBndr pass]
rd_tmvs = [LRuleBndr GhcRn]
tm_bndrs
                        , rd_lhs :: forall pass. RuleDecl pass -> Located (HsExpr pass)
rd_lhs = LHsExpr GhcRn
lhs
                        , rd_rhs :: forall pass. RuleDecl pass -> Located (HsExpr pass)
rd_rhs = LHsExpr GhcRn
rhs }))
  = do { Core (M Dec)
rule <- [LHsTyVarBndr () GhcRn]
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall flag flag' a.
RepTV flag flag' =>
[LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds ([LHsTyVarBndr () GhcRn]
-> Maybe [LHsTyVarBndr () GhcRn] -> [LHsTyVarBndr () GhcRn]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LHsTyVarBndr () GhcRn]
Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
ty_bndrs) ((Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
 -> MetaM (Core (M Dec)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$ \ Core [M (TyVarBndr ())]
ex_bndrs ->
         do { let tm_bndr_names :: [Name]
tm_bndr_names = (LRuleBndr GhcRn -> [Name]) -> [LRuleBndr GhcRn] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LRuleBndr GhcRn -> [Name]
ruleBndrNames [LRuleBndr GhcRn]
tm_bndrs
            ; [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
tm_bndr_names
            ; Core (M Dec)
rule <- [GenSymBind] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (MetaM (Core (M Dec)) -> MetaM (Core (M Dec)))
-> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a b. (a -> b) -> a -> b
$
                      do { Type
elt_ty <- Name -> MetaM Type
wrapName Name
tyVarBndrUnitTyConName
                         ; Core (Maybe [M (TyVarBndr ())])
ty_bndrs' <- Core (Maybe [M (TyVarBndr ())])
-> MetaM (Core (Maybe [M (TyVarBndr ())]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Core (Maybe [M (TyVarBndr ())])
 -> MetaM (Core (Maybe [M (TyVarBndr ())])))
-> Core (Maybe [M (TyVarBndr ())])
-> MetaM (Core (Maybe [M (TyVarBndr ())]))
forall a b. (a -> b) -> a -> b
$ case Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
ty_bndrs of
                             Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
Nothing -> Type -> Core (Maybe [M (TyVarBndr ())])
forall a. Type -> Core (Maybe a)
coreNothing' (Type -> Type
mkListTy Type
elt_ty)
                             Just [LHsTyVarBndr () (NoGhcTc GhcRn)]
_  -> Type -> Core [M (TyVarBndr ())] -> Core (Maybe [M (TyVarBndr ())])
forall a. Type -> Core a -> Core (Maybe a)
coreJust' (Type -> Type
mkListTy Type
elt_ty) Core [M (TyVarBndr ())]
ex_bndrs
                         ; Core [M RuleBndr]
tm_bndrs' <- Name
-> (LRuleBndr GhcRn -> MetaM (Core (M RuleBndr)))
-> [LRuleBndr GhcRn]
-> MetaM (Core [M RuleBndr])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
ruleBndrTyConName
                                                LRuleBndr GhcRn -> MetaM (Core (M RuleBndr))
repRuleBndr
                                                [LRuleBndr GhcRn]
tm_bndrs
                         ; Core String
n'   <- String -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit (String -> ReaderT MetaWrappers DsM (Core String))
-> String -> ReaderT MetaWrappers DsM (Core String)
forall a b. (a -> b) -> a -> b
$ CLabelString -> String
unpackFS (CLabelString -> String) -> CLabelString -> String
forall a b. (a -> b) -> a -> b
$ (SourceText, CLabelString) -> CLabelString
forall a b. (a, b) -> b
snd ((SourceText, CLabelString) -> CLabelString)
-> (SourceText, CLabelString) -> CLabelString
forall a b. (a -> b) -> a -> b
$ Located (SourceText, CLabelString) -> (SourceText, CLabelString)
forall l e. GenLocated l e -> e
unLoc Located (SourceText, CLabelString)
n
                         ; Core Phases
act' <- Activation -> MetaM (Core Phases)
repPhases Activation
act
                         ; Core (M Exp)
lhs' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
lhs
                         ; Core (M Exp)
rhs' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
rhs
                         ; Core String
-> Core (Maybe [M (TyVarBndr ())])
-> Core [M RuleBndr]
-> Core (M Exp)
-> Core (M Exp)
-> Core Phases
-> MetaM (Core (M Dec))
repPragRule Core String
n' Core (Maybe [M (TyVarBndr ())])
ty_bndrs' Core [M RuleBndr]
tm_bndrs' Core (M Exp)
lhs' Core (M Exp)
rhs' Core Phases
act' }
           ; [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
rule  }
       ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
rule) }

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

repRuleBndr :: LRuleBndr GhcRn -> MetaM (Core (M TH.RuleBndr))
repRuleBndr :: LRuleBndr GhcRn -> MetaM (Core (M RuleBndr))
repRuleBndr (L SrcSpan
_ (RuleBndr XCRuleBndr GhcRn
_ Located (IdP GhcRn)
n))
  = do { MkC CoreExpr
n' <- Located Name -> MetaM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
n
       ; Name -> [CoreExpr] -> MetaM (Core (M RuleBndr))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
ruleVarName [CoreExpr
n'] }
repRuleBndr (L SrcSpan
_ (RuleBndrSig XRuleBndrSig GhcRn
_ Located (IdP GhcRn)
n HsPatSigType GhcRn
sig))
  = do { MkC CoreExpr
n'  <- Located Name -> MetaM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
n
       ; MkC CoreExpr
ty' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy (HsPatSigType GhcRn -> LHsType GhcRn
forall pass. HsPatSigType pass -> LHsType pass
hsPatSigType HsPatSigType GhcRn
sig)
       ; Name -> [CoreExpr] -> MetaM (Core (M RuleBndr))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
typedRuleVarName [CoreExpr
n', CoreExpr
ty'] }

repAnnD :: LAnnDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repAnnD :: LAnnDecl GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
repAnnD (L SrcSpan
loc (HsAnnotation XHsAnnotation GhcRn
_ SourceText
_ AnnProvenance (IdP GhcRn)
ann_prov (L SrcSpan
_ HsExpr GhcRn
exp)))
  = do { Core AnnTarget
target <- AnnProvenance Name -> MetaM (Core AnnTarget)
repAnnProv AnnProvenance Name
AnnProvenance (IdP GhcRn)
ann_prov
       ; Core (M Exp)
exp'   <- HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
exp
       ; Core (M Dec)
dec    <- Core AnnTarget -> Core (M Exp) -> MetaM (Core (M Dec))
repPragAnn Core AnnTarget
target Core (M Exp)
exp'
       ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
dec) }

repAnnProv :: AnnProvenance Name -> MetaM (Core TH.AnnTarget)
repAnnProv :: AnnProvenance Name -> MetaM (Core AnnTarget)
repAnnProv (ValueAnnProvenance (L SrcSpan
_ Name
n))
  = do { MkC CoreExpr
n' <- DsM (Core Name) -> MetaM (Core Name)
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  -- ANNs are allowed only at top-level
       ; Name -> [CoreExpr] -> MetaM (Core AnnTarget)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
valueAnnotationName [ CoreExpr
n' ] }
repAnnProv (TypeAnnProvenance (L SrcSpan
_ Name
n))
  = do { MkC CoreExpr
n' <- DsM (Core Name) -> MetaM (Core Name)
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
       ; Name -> [CoreExpr] -> MetaM (Core AnnTarget)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
typeAnnotationName [ CoreExpr
n' ] }
repAnnProv AnnProvenance Name
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 GhcRn -> MetaM (Core (M Con))
repC (L SrcSpan
_ (ConDeclH98 { con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_name   = Located (IdP GhcRn)
con
                      , con_forall :: forall pass. ConDecl pass -> Located Bool
con_forall = (L SrcSpan
_ Bool
False)
                      , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcRn)
Nothing
                      , con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_args   = HsConDeclDetails GhcRn
args }))
  = Located Name -> HsConDeclDetails GhcRn -> MetaM (Core (M Con))
repDataCon Located Name
Located (IdP GhcRn)
con HsConDeclDetails GhcRn
args

repC (L SrcSpan
_ (ConDeclH98 { con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_name = Located (IdP GhcRn)
con
                      , con_forall :: forall pass. ConDecl pass -> Located Bool
con_forall = L SrcSpan
_ Bool
is_existential
                      , con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs = [LHsTyVarBndr Specificity GhcRn]
con_tvs
                      , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcRn)
mcxt
                      , con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_args = HsConDeclDetails GhcRn
args }))
  = do { [LHsTyVarBndr Specificity GhcRn]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con))
forall flag flag' a.
RepTV flag flag' =>
[LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds [LHsTyVarBndr Specificity GhcRn]
con_tvs ((Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
 -> MetaM (Core (M Con)))
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con))
forall a b. (a -> b) -> a -> b
$ \ Core [M (TyVarBndr Specificity)]
ex_bndrs ->
         do { Core (M Con)
c'    <- Located Name -> HsConDeclDetails GhcRn -> MetaM (Core (M Con))
repDataCon Located Name
Located (IdP GhcRn)
con HsConDeclDetails GhcRn
args
            ; Core (M Cxt)
ctxt' <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repMbContext Maybe (LHsContext GhcRn)
mcxt
            ; if Bool -> Bool
not Bool
is_existential Bool -> Bool -> Bool
&& Maybe (LHsContext GhcRn) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (LHsContext GhcRn)
mcxt
              then Core (M Con) -> MetaM (Core (M Con))
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Con)
c'
              else Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forallCName ([Core [M (TyVarBndr Specificity)] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M (TyVarBndr Specificity)]
ex_bndrs, Core (M Cxt) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Cxt)
ctxt', Core (M Con) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Con)
c'])
            }
       }

repC (L SrcSpan
_ (ConDeclGADT { con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_g_ext  = XConDeclGADT GhcRn
imp_tvs
                       , con_names :: forall pass. ConDecl pass -> [Located (IdP pass)]
con_names  = [Located (IdP GhcRn)]
cons
                       , con_qvars :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_qvars  = [LHsTyVarBndr Specificity GhcRn]
exp_tvs
                       , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcRn)
mcxt
                       , con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_args   = HsConDeclDetails GhcRn
args
                       , con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty = LHsType GhcRn
res_ty }))
  | [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
XConDeclGADT GhcRn
imp_tvs Bool -> Bool -> Bool
&& [LHsTyVarBndr Specificity GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity GhcRn]
exp_tvs -- No implicit or explicit variables
  , Maybe (LHsContext GhcRn)
Nothing <- Maybe (LHsContext GhcRn)
mcxt              -- No context
                                 -- ==> no need for a forall
  = [Located Name]
-> HsConDeclDetails GhcRn -> LHsType GhcRn -> MetaM (Core (M Con))
repGadtDataCons [Located Name]
[Located (IdP GhcRn)]
cons HsConDeclDetails GhcRn
args LHsType GhcRn
res_ty

  | Bool
otherwise
  = [LHsTyVarBndr Specificity GhcRn]
-> [Name]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Con)))
-> MetaM (Core (M Con))
forall flag flag' a.
RepTV flag flag' =>
[LHsTyVarBndr flag GhcRn]
-> [Name]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyVarBinds [LHsTyVarBndr Specificity GhcRn]
exp_tvs [Name]
XConDeclGADT GhcRn
imp_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 ->
             -- See Note [Don't quantify implicit type variables in quotes]
    do { Core (M Con)
c'    <- [Located Name]
-> HsConDeclDetails GhcRn -> LHsType GhcRn -> MetaM (Core (M Con))
repGadtDataCons [Located Name]
[Located (IdP GhcRn)]
cons HsConDeclDetails GhcRn
args LHsType GhcRn
res_ty
       ; Core (M Cxt)
ctxt' <- Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repMbContext Maybe (LHsContext GhcRn)
mcxt
       ; if [LHsTyVarBndr Specificity GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity GhcRn]
exp_tvs Bool -> Bool -> Bool
&& Maybe (LHsContext GhcRn) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (LHsContext GhcRn)
mcxt
         then Core (M Con) -> MetaM (Core (M Con))
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Con)
c'
         else Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forallCName ([Core [M (TyVarBndr Specificity)] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M (TyVarBndr Specificity)]
ex_bndrs, Core (M Cxt) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Cxt)
ctxt', Core (M Con) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Con)
c']) }


repMbContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M TH.Cxt))
repMbContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M Cxt))
repMbContext Maybe (LHsContext GhcRn)
Nothing          = HsContext GhcRn -> MetaM (Core (M Cxt))
repContext []
repMbContext (Just (L SrcSpan
_ HsContext GhcRn
cxt)) = HsContext GhcRn -> MetaM (Core (M Cxt))
repContext HsContext GhcRn
cxt

repSrcUnpackedness :: SrcUnpackedness -> MetaM (Core (M TH.SourceUnpackedness))
repSrcUnpackedness :: SrcUnpackedness -> MetaM (Core (M SourceUnpackedness))
repSrcUnpackedness SrcUnpackedness
SrcUnpack   = Name -> [CoreExpr] -> MetaM (Core (M SourceUnpackedness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceUnpackName         []
repSrcUnpackedness SrcUnpackedness
SrcNoUnpack = Name -> [CoreExpr] -> MetaM (Core (M SourceUnpackedness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceNoUnpackName       []
repSrcUnpackedness SrcUnpackedness
NoSrcUnpack = Name -> [CoreExpr] -> MetaM (Core (M SourceUnpackedness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
noSourceUnpackednessName []

repSrcStrictness :: SrcStrictness -> MetaM (Core (M TH.SourceStrictness))
repSrcStrictness :: SrcStrictness -> MetaM (Core (M SourceStrictness))
repSrcStrictness SrcStrictness
SrcLazy     = Name -> [CoreExpr] -> MetaM (Core (M SourceStrictness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceLazyName         []
repSrcStrictness SrcStrictness
SrcStrict   = Name -> [CoreExpr] -> MetaM (Core (M SourceStrictness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sourceStrictName       []
repSrcStrictness SrcStrictness
NoSrcStrict = Name -> [CoreExpr] -> MetaM (Core (M SourceStrictness))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
noSourceStrictnessName []

repBangTy :: LBangType GhcRn -> MetaM (Core (M TH.BangType))
repBangTy :: LHsType GhcRn -> MetaM (Core (M BangType))
repBangTy LHsType GhcRn
ty = do
  MkC CoreExpr
u <- SrcUnpackedness -> MetaM (Core (M SourceUnpackedness))
repSrcUnpackedness SrcUnpackedness
su'
  MkC CoreExpr
s <- SrcStrictness -> MetaM (Core (M SourceStrictness))
repSrcStrictness SrcStrictness
ss'
  MkC CoreExpr
b <- Name -> [CoreExpr] -> MetaM (Core (M Any))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
bangName [CoreExpr
u, CoreExpr
s]
  MkC CoreExpr
t <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ty'
  Name -> [CoreExpr] -> MetaM (Core (M BangType))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
bangTypeName [CoreExpr
b, CoreExpr
t]
  where
    (SrcUnpackedness
su', SrcStrictness
ss', LHsType GhcRn
ty') = case LHsType GhcRn -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc LHsType GhcRn
ty of
            HsBangTy XBangTy GhcRn
_ (HsSrcBang SourceText
_ SrcUnpackedness
su SrcStrictness
ss) LHsType GhcRn
ty -> (SrcUnpackedness
su, SrcStrictness
ss, LHsType GhcRn
ty)
            HsType GhcRn
_ -> (SrcUnpackedness
NoSrcUnpack, SrcStrictness
NoSrcStrict, LHsType GhcRn
ty)

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

repDerivs :: HsDeriving GhcRn -> MetaM (Core [M TH.DerivClause])
repDerivs :: HsDeriving GhcRn -> MetaM (Core [M DerivClause])
repDerivs (L SrcSpan
_ [LHsDerivingClause GhcRn]
clauses)
  = Name
-> (LHsDerivingClause GhcRn -> MetaM (Core (M DerivClause)))
-> [LHsDerivingClause GhcRn]
-> MetaM (Core [M DerivClause])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
derivClauseTyConName LHsDerivingClause GhcRn -> MetaM (Core (M DerivClause))
repDerivClause [LHsDerivingClause GhcRn]
clauses

repDerivClause :: LHsDerivingClause GhcRn
               -> MetaM (Core (M TH.DerivClause))
repDerivClause :: LHsDerivingClause GhcRn -> MetaM (Core (M DerivClause))
repDerivClause (L SrcSpan
_ (HsDerivingClause
                          { deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy = Maybe (LDerivStrategy GhcRn)
dcs
                          , deriv_clause_tys :: forall pass. HsDerivingClause pass -> Located [LHsSigType pass]
deriv_clause_tys      = L SrcSpan
_ [LHsSigType GhcRn]
dct }))
  = Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M DerivClause)))
-> MetaM (Core (M DerivClause))
forall a.
Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy Maybe (LDerivStrategy GhcRn)
dcs ((Core (Maybe (M DerivStrategy)) -> MetaM (Core (M DerivClause)))
 -> MetaM (Core (M DerivClause)))
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M DerivClause)))
-> MetaM (Core (M DerivClause))
forall a b. (a -> b) -> a -> b
$ \(MkC CoreExpr
dcs') ->
    do MkC CoreExpr
dct' <- Name
-> (LHsSigType GhcRn -> MetaM (Core (M Type)))
-> [LHsSigType GhcRn]
-> MetaM (Core [M Type])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
typeTyConName (LHsType GhcRn -> MetaM (Core (M Type))
rep_deriv_ty (LHsType GhcRn -> MetaM (Core (M Type)))
-> (LHsSigType GhcRn -> LHsType GhcRn)
-> LHsSigType GhcRn
-> MetaM (Core (M Type))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsSigType GhcRn -> LHsType GhcRn
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType) [LHsSigType GhcRn]
dct
       Name -> [CoreExpr] -> MetaM (Core (M DerivClause))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
derivClauseName [CoreExpr
dcs',CoreExpr
dct']
  where
    rep_deriv_ty :: LHsType GhcRn -> MetaM (Core (M TH.Type))
    rep_deriv_ty :: LHsType GhcRn -> MetaM (Core (M Type))
rep_deriv_ty LHsType GhcRn
ty = LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ty

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 GhcRn]
-> LHsBindsLR GhcRn GhcRn -> MetaM ([GenSymBind], [Core (M Dec)])
rep_meth_sigs_binds [LSig GhcRn]
sigs LHsBindsLR GhcRn GhcRn
binds
  = do { let tvs :: [Name]
tvs = (LSig GhcRn -> [Name]) -> [LSig GhcRn] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LSig GhcRn -> [Name]
get_scoped_tvs [LSig GhcRn]
sigs
       ; [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
tvs
       ; [(SrcSpan, Core (M Dec))]
sigs1 <- [GenSymBind]
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (MetaM [(SrcSpan, Core (M Dec))]
 -> MetaM [(SrcSpan, Core (M Dec))])
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a b. (a -> b) -> a -> b
$ [LSig GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
rep_sigs [LSig GhcRn]
sigs
       ; [(SrcSpan, Core (M Dec))]
binds1 <- [GenSymBind]
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (MetaM [(SrcSpan, Core (M Dec))]
 -> MetaM [(SrcSpan, Core (M Dec))])
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a b. (a -> b) -> a -> b
$ LHsBindsLR GhcRn GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_binds LHsBindsLR GhcRn GhcRn
binds
       ; ([GenSymBind], [Core (M Dec)])
-> MetaM ([GenSymBind], [Core (M Dec)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss, [(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc ([(SrcSpan, Core (M Dec))]
sigs1 [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
binds1))) }

-------------------------------------------------------
--   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 GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
rep_sigs = (LSig GhcRn -> MetaM [(SrcSpan, Core (M Dec))])
-> [LSig GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM LSig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_sig

rep_sig :: LSig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_sig :: LSig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_sig (L SrcSpan
loc (TypeSig XTypeSig GhcRn
_ [Located (IdP GhcRn)]
nms LHsSigWcType GhcRn
ty))
  = (Located Name -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [Located Name] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name
-> SrcSpan
-> LHsSigWcType GhcRn
-> Located Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_wc_ty_sig Name
sigDName SrcSpan
loc LHsSigWcType GhcRn
ty) [Located Name]
[Located (IdP GhcRn)]
nms
rep_sig (L SrcSpan
loc (PatSynSig XPatSynSig GhcRn
_ [Located (IdP GhcRn)]
nms LHsSigType GhcRn
ty))
  = (Located Name -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [Located Name] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SrcSpan
-> LHsSigType GhcRn
-> Located Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_patsyn_ty_sig SrcSpan
loc LHsSigType GhcRn
ty) [Located Name]
[Located (IdP GhcRn)]
nms
rep_sig (L SrcSpan
loc (ClassOpSig XClassOpSig GhcRn
_ Bool
is_deflt [Located (IdP GhcRn)]
nms LHsSigType GhcRn
ty))
  | Bool
is_deflt     = (Located Name -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [Located Name] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name
-> SrcSpan
-> LHsSigType GhcRn
-> Located Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
defaultSigDName SrcSpan
loc LHsSigType GhcRn
ty) [Located Name]
[Located (IdP GhcRn)]
nms
  | Bool
otherwise    = (Located Name -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [Located Name] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name
-> SrcSpan
-> LHsSigType GhcRn
-> Located Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
sigDName SrcSpan
loc LHsSigType GhcRn
ty) [Located Name]
[Located (IdP GhcRn)]
nms
rep_sig d :: LSig GhcRn
d@(L SrcSpan
_ (IdSig {}))           = String -> SDoc -> MetaM [(SrcSpan, Core (M Dec))]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rep_sig IdSig" (LSig GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr LSig GhcRn
d)
rep_sig (L SrcSpan
loc (FixSig XFixSig GhcRn
_ FixitySig GhcRn
fix_sig))   = SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_fix_d SrcSpan
loc FixitySig GhcRn
fix_sig
rep_sig (L SrcSpan
loc (InlineSig XInlineSig GhcRn
_ Located (IdP GhcRn)
nm InlinePragma
ispec))= Located Name
-> InlinePragma -> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_inline Located Name
Located (IdP GhcRn)
nm InlinePragma
ispec SrcSpan
loc
rep_sig (L SrcSpan
loc (SpecSig XSpecSig GhcRn
_ Located (IdP GhcRn)
nm [LHsSigType GhcRn]
tys InlinePragma
ispec))
  = (LHsSigType GhcRn -> MetaM [(SrcSpan, Core (M Dec))])
-> [LHsSigType GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (\LHsSigType GhcRn
t -> Located Name
-> LHsSigType GhcRn
-> InlinePragma
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_specialise Located Name
Located (IdP GhcRn)
nm LHsSigType GhcRn
t InlinePragma
ispec SrcSpan
loc) [LHsSigType GhcRn]
tys
rep_sig (L SrcSpan
loc (SpecInstSig XSpecInstSig GhcRn
_ SourceText
_ LHsSigType GhcRn
ty))  = LHsSigType GhcRn -> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_specialiseInst LHsSigType GhcRn
ty SrcSpan
loc
rep_sig (L SrcSpan
_   (MinimalSig {}))       = String -> SDoc -> MetaM [(SrcSpan, Core (M Dec))]
forall a. String -> SDoc -> MetaM a
notHandled String
"MINIMAL pragmas" SDoc
empty
rep_sig (L SrcSpan
_   (SCCFunSig {}))        = String -> SDoc -> MetaM [(SrcSpan, Core (M Dec))]
forall a. String -> SDoc -> MetaM a
notHandled String
"SCC pragmas" SDoc
empty
rep_sig (L SrcSpan
loc (CompleteMatchSig XCompleteMatchSig GhcRn
_ SourceText
_st Located [Located (IdP GhcRn)]
cls Maybe (Located (IdP GhcRn))
mty))
  = Located [Located Name]
-> Maybe (Located Name)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_complete_sig Located [Located Name]
Located [Located (IdP GhcRn)]
cls Maybe (Located Name)
Maybe (Located (IdP GhcRn))
mty SrcSpan
loc

-- 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.TyVarBndrSpec])
rep_ty_sig_tvs :: [LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity GhcRn]
explicit_tvs
  = let rep_in_scope_tv :: LHsTyVarBndr flag GhcRn
-> ReaderT MetaWrappers DsM (Core (M (TyVarBndr flag')))
rep_in_scope_tv LHsTyVarBndr flag GhcRn
tv = do { Core Name
name <- Name -> MetaM (Core Name)
lookupBinder (LHsTyVarBndr flag GhcRn -> IdP GhcRn
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName LHsTyVarBndr flag GhcRn
tv)
                                ; LHsTyVarBndr flag GhcRn
-> Core Name
-> ReaderT MetaWrappers DsM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn
-> Core Name -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndrWithKind LHsTyVarBndr flag GhcRn
tv Core Name
name } in
    Name
-> (LHsTyVarBndr Specificity GhcRn
    -> MetaM (Core (M (TyVarBndr Specificity))))
-> [LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M (TyVarBndr Specificity)])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
tyVarBndrSpecTyConName LHsTyVarBndr Specificity GhcRn
-> MetaM (Core (M (TyVarBndr Specificity)))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn -> MetaM (Core (M (TyVarBndr flag')))
rep_in_scope_tv
             [LHsTyVarBndr Specificity GhcRn]
explicit_tvs
         -- NB: Don't pass any implicit type variables to repList above
         -- See Note [Don't quantify implicit type variables in quotes]

-- 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 -> Located Name
           -> MetaM (SrcSpan, Core (M TH.Dec))
rep_ty_sig :: Name
-> SrcSpan
-> LHsSigType GhcRn
-> Located Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
mk_sig SrcSpan
loc LHsSigType GhcRn
sig_ty Located Name
nm
  = do { Core Name
nm1 <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
nm
       ; Core (M Type)
ty1 <- LHsSigType GhcRn -> MetaM (Core (M Type))
rep_ty_sig' LHsSigType GhcRn
sig_ty
       ; Core (M Dec)
sig <- Name -> Core Name -> Core (M Type) -> MetaM (Core (M Dec))
repProto Name
mk_sig Core Name
nm1 Core (M Type)
ty1
       ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
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 GhcRn -> MetaM (Core (M Type))
rep_ty_sig' LHsSigType GhcRn
sig_ty
  | HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcRn
hs_ty } <- LHsSigType GhcRn
sig_ty
  , ([LHsTyVarBndr Specificity GhcRn]
explicit_tvs, LHsContext GhcRn
ctxt, LHsType GhcRn
ty) <- LHsType GhcRn
-> ([LHsTyVarBndr Specificity GhcRn], LHsContext GhcRn,
    LHsType GhcRn)
forall pass.
LHsType pass
-> ([LHsTyVarBndr Specificity pass], LHsContext pass, LHsType pass)
splitLHsSigmaTyInvis LHsType GhcRn
hs_ty
  = do { Core [M (TyVarBndr Specificity)]
th_explicit_tvs <- [LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity GhcRn]
explicit_tvs
       ; Core (M Cxt)
th_ctxt <- LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
ctxt
       ; Core (M Type)
th_ty   <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ty
       ; if [LHsTyVarBndr Specificity GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity GhcRn]
explicit_tvs Bool -> Bool -> Bool
&& HsContext GhcRn -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LHsContext GhcRn -> HsContext GhcRn
forall l e. GenLocated l e -> e
unLoc LHsContext GhcRn
ctxt)
            then Core (M Type) -> MetaM (Core (M Type))
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Type)
th_ty
            else Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
th_explicit_tvs Core (M Cxt)
th_ctxt Core (M Type)
th_ty }

rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> Located 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 GhcRn
-> Located Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_patsyn_ty_sig SrcSpan
loc LHsSigType GhcRn
sig_ty Located Name
nm
  | HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcRn
hs_ty } <- LHsSigType GhcRn
sig_ty
  , ([LHsTyVarBndr Specificity GhcRn]
univs, LHsContext GhcRn
reqs, [LHsTyVarBndr Specificity GhcRn]
exis, LHsContext GhcRn
provs, LHsType GhcRn
ty) <- LHsType GhcRn
-> ([LHsTyVarBndr Specificity GhcRn], LHsContext GhcRn,
    [LHsTyVarBndr Specificity GhcRn], LHsContext GhcRn, LHsType GhcRn)
forall pass.
LHsType pass
-> ([LHsTyVarBndr Specificity pass], LHsContext pass,
    [LHsTyVarBndr Specificity pass], LHsContext pass, LHsType pass)
splitLHsPatSynTy LHsType GhcRn
hs_ty
  = do { Core Name
nm1 <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
nm
       ; Core [M (TyVarBndr Specificity)]
th_univs <- [LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity GhcRn]
univs
       ; Core [M (TyVarBndr Specificity)]
th_exis  <- [LHsTyVarBndr Specificity GhcRn]
-> MetaM (Core [M (TyVarBndr Specificity)])
rep_ty_sig_tvs [LHsTyVarBndr Specificity GhcRn]
exis

       ; Core (M Cxt)
th_reqs  <- LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
reqs
       ; Core (M Cxt)
th_provs <- LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
provs
       ; Core (M Type)
th_ty    <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ty
       ; Core (M Type)
ty1      <- Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
th_univs Core (M Cxt)
th_reqs (Core (M Type) -> MetaM (Core (M Type)))
-> MetaM (Core (M Type)) -> MetaM (Core (M Type))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                       Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
th_exis Core (M Cxt)
th_provs Core (M Type)
th_ty
       ; Core (M Dec)
sig      <- Name -> Core Name -> Core (M Type) -> MetaM (Core (M Dec))
repProto Name
patSynSigDName Core Name
nm1 Core (M Type)
ty1
       ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
sig) }

rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> Located Name
              -> MetaM (SrcSpan, Core (M TH.Dec))
rep_wc_ty_sig :: Name
-> SrcSpan
-> LHsSigWcType GhcRn
-> Located Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_wc_ty_sig Name
mk_sig SrcSpan
loc LHsSigWcType GhcRn
sig_ty Located Name
nm
  = Name
-> SrcSpan
-> LHsSigType GhcRn
-> Located Name
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_ty_sig Name
mk_sig SrcSpan
loc (LHsSigWcType GhcRn -> LHsSigType GhcRn
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsSigWcType GhcRn
sig_ty) Located Name
nm

rep_inline :: Located Name
           -> InlinePragma      -- Never defaultInlinePragma
           -> SrcSpan
           -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_inline :: Located Name
-> InlinePragma -> SrcSpan -> MetaM [(SrcSpan, Core (M Dec))]
rep_inline Located Name
nm InlinePragma
ispec SrcSpan
loc
  = do { Core Name
nm1    <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
nm
       ; Core Inline
inline <- InlineSpec -> MetaM (Core Inline)
repInline (InlineSpec -> MetaM (Core Inline))
-> InlineSpec -> MetaM (Core Inline)
forall a b. (a -> b) -> a -> b
$ InlinePragma -> InlineSpec
inl_inline InlinePragma
ispec
       ; Core RuleMatch
rm     <- RuleMatchInfo -> MetaM (Core RuleMatch)
repRuleMatch (RuleMatchInfo -> MetaM (Core RuleMatch))
-> RuleMatchInfo -> MetaM (Core RuleMatch)
forall a b. (a -> b) -> a -> b
$ InlinePragma -> RuleMatchInfo
inl_rule InlinePragma
ispec
       ; Core Phases
phases <- Activation -> MetaM (Core Phases)
repPhases (Activation -> MetaM (Core Phases))
-> Activation -> MetaM (Core Phases)
forall a b. (a -> b) -> a -> b
$ InlinePragma -> Activation
inl_act InlinePragma
ispec
       ; Core (M Dec)
pragma <- Core Name
-> Core Inline
-> Core RuleMatch
-> Core Phases
-> MetaM (Core (M Dec))
repPragInl Core Name
nm1 Core Inline
inline Core RuleMatch
rm Core Phases
phases
       ; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core (M Dec)
pragma)]
       }

rep_specialise :: Located Name -> LHsSigType GhcRn -> InlinePragma
               -> SrcSpan
               -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_specialise :: Located Name
-> LHsSigType GhcRn
-> InlinePragma
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_specialise Located Name
nm LHsSigType GhcRn
ty InlinePragma
ispec SrcSpan
loc
  = do { Core Name
nm1 <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
nm
       ; Core (M Type)
ty1 <- LHsSigType GhcRn -> MetaM (Core (M Type))
repHsSigType LHsSigType GhcRn
ty
       ; Core Phases
phases <- Activation -> MetaM (Core Phases)
repPhases (Activation -> MetaM (Core Phases))
-> Activation -> MetaM (Core Phases)
forall a b. (a -> b) -> a -> b
$ InlinePragma -> Activation
inl_act InlinePragma
ispec
       ; let inline :: InlineSpec
inline = InlinePragma -> InlineSpec
inl_inline InlinePragma
ispec
       ; Core (M Dec)
pragma <- if InlineSpec -> Bool
noUserInlineSpec InlineSpec
inline
                   then -- SPECIALISE
                     Core Name -> Core (M Type) -> Core Phases -> MetaM (Core (M Dec))
repPragSpec Core Name
nm1 Core (M Type)
ty1 Core Phases
phases
                   else -- SPECIALISE INLINE
                     do { Core Inline
inline1 <- InlineSpec -> MetaM (Core Inline)
repInline InlineSpec
inline
                        ; Core Name
-> Core (M Type)
-> Core Inline
-> Core Phases
-> MetaM (Core (M Dec))
repPragSpecInl Core Name
nm1 Core (M Type)
ty1 Core Inline
inline1 Core Phases
phases }
       ; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core (M Dec)
pragma)]
       }

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

repInline :: InlineSpec -> MetaM (Core TH.Inline)
repInline :: InlineSpec -> MetaM (Core Inline)
repInline InlineSpec
NoInline     = Name -> MetaM (Core Inline)
forall a. Name -> MetaM (Core a)
dataCon Name
noInlineDataConName
repInline InlineSpec
Inline       = Name -> MetaM (Core Inline)
forall a. Name -> MetaM (Core a)
dataCon Name
inlineDataConName
repInline InlineSpec
Inlinable    = Name -> MetaM (Core Inline)
forall a. Name -> MetaM (Core a)
dataCon Name
inlinableDataConName
repInline InlineSpec
NoUserInline = String -> SDoc -> MetaM (Core Inline)
forall a. String -> SDoc -> MetaM a
notHandled String
"NOUSERINLINE" SDoc
empty

repRuleMatch :: RuleMatchInfo -> MetaM (Core TH.RuleMatch)
repRuleMatch :: RuleMatchInfo -> MetaM (Core RuleMatch)
repRuleMatch RuleMatchInfo
ConLike = Name -> MetaM (Core RuleMatch)
forall a. Name -> MetaM (Core a)
dataCon Name
conLikeDataConName
repRuleMatch RuleMatchInfo
FunLike = Name -> MetaM (Core RuleMatch)
forall a. Name -> MetaM (Core a)
dataCon Name
funLikeDataConName

repPhases :: Activation -> MetaM (Core TH.Phases)
repPhases :: Activation -> MetaM (Core Phases)
repPhases (ActiveBefore SourceText
_ Int
i) = do { MkC CoreExpr
arg <- Int -> MetaM (Core Int)
coreIntLit Int
i
                                  ; Name -> [CoreExpr] -> MetaM (Core Phases)
forall a. Name -> [CoreExpr] -> MetaM (Core a)
dataCon' Name
beforePhaseDataConName [CoreExpr
arg] }
repPhases (ActiveAfter SourceText
_ Int
i)  = do { MkC CoreExpr
arg <- Int -> MetaM (Core Int)
coreIntLit Int
i
                                  ; Name -> [CoreExpr] -> MetaM (Core Phases)
forall a. Name -> [CoreExpr] -> MetaM (Core a)
dataCon' Name
fromPhaseDataConName [CoreExpr
arg] }
repPhases Activation
_                  = Name -> MetaM (Core Phases)
forall a. Name -> MetaM (Core a)
dataCon Name
allPhasesDataConName

rep_complete_sig :: Located [Located Name]
                 -> Maybe (Located Name)
                 -> SrcSpan
                 -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_complete_sig :: Located [Located Name]
-> Maybe (Located Name)
-> SrcSpan
-> MetaM [(SrcSpan, Core (M Dec))]
rep_complete_sig (L SrcSpan
_ [Located Name]
cls) Maybe (Located Name)
mty SrcSpan
loc
  = do { Core (Maybe Name)
mty' <- Name
-> (Located Name -> MetaM (Core Name))
-> Maybe (Located Name)
-> MetaM (Core (Maybe Name))
forall a b.
Name -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
repMaybe Name
nameTyConName Located Name -> MetaM (Core Name)
lookupLOcc Maybe (Located Name)
mty
       ; Core [Name]
cls' <- Name
-> (Located Name -> MetaM (Core Name))
-> [Located Name]
-> MetaM (Core [Name])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
nameTyConName Located Name -> MetaM (Core Name)
lookupLOcc [Located Name]
cls
       ; Core (M Dec)
sig <- Core [Name] -> Core (Maybe Name) -> MetaM (Core (M Dec))
repPragComplete Core [Name]
cls' Core (Maybe Name)
mty'
       ; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core (M Dec)
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 a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
plainTVName  [CoreExpr
nm]
    repKindedTV :: Core Name -> () -> Core (M Type) -> MetaM (Core (M (TyVarBndr ())))
repKindedTV (MkC CoreExpr
nm) () (MkC CoreExpr
ki) = Name -> [CoreExpr] -> MetaM (Core (M (TyVarBndr ())))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
kindedTVName [CoreExpr
nm, CoreExpr
ki]

instance RepTV Specificity TH.Specificity where
    tyVarBndrName :: Name
tyVarBndrName = Name
tyVarBndrSpecTyConName
    repPlainTV :: Core Name
-> Specificity -> MetaM (Core (M (TyVarBndr Specificity)))
repPlainTV  (MkC CoreExpr
nm) Specificity
spec          = do { (MkC CoreExpr
spec') <- Specificity -> MetaM (Core Specificity)
rep_flag Specificity
spec
                                            ; Name -> [CoreExpr] -> MetaM (Core (M (TyVarBndr Specificity)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
plainInvisTVName  [CoreExpr
nm, CoreExpr
spec'] }
    repKindedTV :: Core Name
-> Specificity
-> Core (M Type)
-> MetaM (Core (M (TyVarBndr Specificity)))
repKindedTV (MkC CoreExpr
nm) Specificity
spec (MkC CoreExpr
ki) = do { (MkC CoreExpr
spec') <- Specificity -> MetaM (Core Specificity)
rep_flag Specificity
spec
                                            ; Name -> [CoreExpr] -> MetaM (Core (M (TyVarBndr Specificity)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
kindedInvisTVName [CoreExpr
nm, CoreExpr
spec', CoreExpr
ki] }

rep_flag :: Specificity -> MetaM (Core TH.Specificity)
rep_flag :: Specificity -> MetaM (Core Specificity)
rep_flag Specificity
SpecifiedSpec = Name -> [CoreExpr] -> MetaM (Core Specificity)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
specifiedSpecName []
rep_flag Specificity
InferredSpec  = Name -> [CoreExpr] -> MetaM (Core Specificity)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
inferredSpecName []

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

addHsTyVarBinds :: forall flag flag' a. RepTV flag flag'
                => [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 flag flag' a.
RepTV flag flag' =>
[LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds [LHsTyVarBndr flag GhcRn]
exp_tvs Core [M (TyVarBndr flag')] -> MetaM (Core (M a))
thing_inside
  = do { [GenSymBind]
fresh_exp_names <- [Name] -> MetaM [GenSymBind]
mkGenSyms ([LHsTyVarBndr flag GhcRn] -> [IdP GhcRn]
forall flag (p :: Pass).
[LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr flag GhcRn]
exp_tvs)
       ; Core (M a)
term <- [GenSymBind] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
fresh_exp_names (MetaM (Core (M a)) -> MetaM (Core (M a)))
-> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$
                 do { Core [M (TyVarBndr flag')]
kbs <- Name
-> ((LHsTyVarBndr flag GhcRn, GenSymBind)
    -> MetaM (Core (M (TyVarBndr flag'))))
-> [(LHsTyVarBndr flag GhcRn, GenSymBind)]
-> MetaM (Core [M (TyVarBndr flag')])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM (forall flag flag'. RepTV flag flag' => Name
tyVarBndrName @flag @flag') (LHsTyVarBndr flag GhcRn, GenSymBind)
-> MetaM (Core (M (TyVarBndr flag')))
forall {flag} {flag'} {a}.
RepTV flag flag' =>
(LHsTyVarBndr flag GhcRn, (a, Id))
-> MetaM (Core (M (TyVarBndr flag')))
mk_tv_bndr
                                     ([LHsTyVarBndr flag GhcRn]
exp_tvs [LHsTyVarBndr flag GhcRn]
-> [GenSymBind] -> [(LHsTyVarBndr flag GhcRn, GenSymBind)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [GenSymBind]
fresh_exp_names)
                    ; Core [M (TyVarBndr flag')] -> MetaM (Core (M a))
thing_inside Core [M (TyVarBndr flag')]
kbs }
       ; [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
fresh_exp_names Core (M a)
term }
  where
    mk_tv_bndr :: (LHsTyVarBndr flag GhcRn, (a, Id))
-> MetaM (Core (M (TyVarBndr flag')))
mk_tv_bndr (LHsTyVarBndr flag GhcRn
tv, (a
_,Id
v)) = LHsTyVarBndr flag GhcRn
-> Core Name -> MetaM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn
-> Core Name -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndrWithKind LHsTyVarBndr flag GhcRn
tv (Id -> Core Name
coreVar Id
v)

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

addTyVarBinds :: RepTV flag flag'
              => [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 flag flag' a.
RepTV flag flag' =>
[LHsTyVarBndr flag GhcRn]
-> [Name]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyVarBinds [LHsTyVarBndr flag GhcRn]
exp_tvs [Name]
imp_tvs Core [M (TyVarBndr flag')] -> MetaM (Core (M a))
thing_inside
  = [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a. [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds [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
$
    [LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall flag flag' a.
RepTV flag flag' =>
[LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds [LHsTyVarBndr flag GhcRn]
exp_tvs ((Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
 -> MetaM (Core (M a)))
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$
    Core [M (TyVarBndr flag')] -> MetaM (Core (M a))
thing_inside

addTyClTyVarBinds :: LHsQTyVars GhcRn
                  -> (Core [(M (TH.TyVarBndr ()))] -> MetaM (Core (M a)))
                  -> MetaM (Core (M a))
-- Used for data/newtype declarations, and family instances,
-- so that the nested type variables work right
--    instance C (T a) where
--      type W (T a) = blah
-- The 'a' in the type instance is the one bound by the instance decl
addTyClTyVarBinds :: forall a.
LHsQTyVars GhcRn
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addTyClTyVarBinds LHsQTyVars GhcRn
tvs Core [M (TyVarBndr ())] -> MetaM (Core (M a))
m
  = do { let tv_names :: [Name]
tv_names = LHsQTyVars GhcRn -> [Name]
hsAllLTyVarNames LHsQTyVars GhcRn
tvs
       ; DsMetaEnv
env <- IOEnv (Env DsGblEnv DsLclEnv) DsMetaEnv
-> ReaderT MetaWrappers DsM DsMetaEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env DsGblEnv DsLclEnv) DsMetaEnv
 -> ReaderT MetaWrappers DsM DsMetaEnv)
-> IOEnv (Env DsGblEnv DsLclEnv) DsMetaEnv
-> ReaderT MetaWrappers DsM DsMetaEnv
forall a b. (a -> b) -> a -> b
$ IOEnv (Env DsGblEnv DsLclEnv) DsMetaEnv
dsGetMetaEnv
       ; [GenSymBind]
freshNames <- [Name] -> MetaM [GenSymBind]
mkGenSyms ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filterOut (Name -> DsMetaEnv -> Bool
forall a. Name -> NameEnv a -> Bool
`elemNameEnv` DsMetaEnv
env) [Name]
tv_names)
            -- Make fresh names for the ones that are not already in scope
            -- This makes things work for family declarations

       ; Core (M a)
term <- [GenSymBind] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
freshNames (MetaM (Core (M a)) -> MetaM (Core (M a)))
-> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$
                 do { Core [M (TyVarBndr ())]
kbs <- Name
-> (LHsTyVarBndr () GhcRn -> MetaM (Core (M (TyVarBndr ()))))
-> [LHsTyVarBndr () GhcRn]
-> MetaM (Core [M (TyVarBndr ())])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
tyVarBndrUnitTyConName LHsTyVarBndr () GhcRn -> MetaM (Core (M (TyVarBndr ())))
mk_tv_bndr
                                     (LHsQTyVars GhcRn -> [LHsTyVarBndr () GhcRn]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsQTvExplicit LHsQTyVars GhcRn
tvs)
                    ; Core [M (TyVarBndr ())] -> MetaM (Core (M a))
m Core [M (TyVarBndr ())]
kbs }

       ; [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
freshNames Core (M a)
term }
  where
    mk_tv_bndr :: LHsTyVarBndr () GhcRn -> MetaM (Core (M (TH.TyVarBndr ())))
    mk_tv_bndr :: LHsTyVarBndr () GhcRn -> MetaM (Core (M (TyVarBndr ())))
mk_tv_bndr LHsTyVarBndr () GhcRn
tv = do { Core Name
v <- Name -> MetaM (Core Name)
lookupBinder (LHsTyVarBndr () GhcRn -> IdP GhcRn
forall flag (p :: Pass).
LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName LHsTyVarBndr () GhcRn
tv)
                       ; LHsTyVarBndr () GhcRn
-> Core Name -> MetaM (Core (M (TyVarBndr ())))
forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn
-> Core Name -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndrWithKind LHsTyVarBndr () GhcRn
tv Core Name
v }

-- Produce kinded binder constructors from the Haskell tyvar binders
--
repTyVarBndrWithKind :: RepTV flag flag' => LHsTyVarBndr flag GhcRn
                     -> Core TH.Name -> MetaM (Core (M (TH.TyVarBndr flag')))
repTyVarBndrWithKind :: forall flag flag'.
RepTV flag flag' =>
LHsTyVarBndr flag GhcRn
-> Core Name -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndrWithKind (L SrcSpan
_ (UserTyVar XUserTyVar GhcRn
_ flag
fl Located (IdP GhcRn)
_)) Core Name
nm
  = Core Name -> flag -> MetaM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
Core Name -> flag -> MetaM (Core (M (TyVarBndr flag')))
repPlainTV Core Name
nm flag
fl
repTyVarBndrWithKind (L SrcSpan
_ (KindedTyVar XKindedTyVar GhcRn
_ flag
fl Located (IdP GhcRn)
_ LHsType GhcRn
ki)) Core Name
nm
  = do { Core (M Type)
ki' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ki
       ; Core Name
-> flag -> Core (M Type) -> MetaM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
Core Name
-> flag -> Core (M Type) -> MetaM (Core (M (TyVarBndr flag')))
repKindedTV Core Name
nm flag
fl Core (M Type)
ki' }

-- | 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 GhcRn -> MetaM (Core (M (TyVarBndr flag')))
repTyVarBndr (L SrcSpan
_ (UserTyVar XUserTyVar GhcRn
_ flag
fl (L SrcSpan
_ IdP GhcRn
nm)) )
  = do { Core Name
nm' <- Name -> MetaM (Core Name)
lookupBinder Name
IdP GhcRn
nm
       ; Core Name -> flag -> MetaM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
Core Name -> flag -> MetaM (Core (M (TyVarBndr flag')))
repPlainTV Core Name
nm' flag
fl }
repTyVarBndr (L SrcSpan
_ (KindedTyVar XKindedTyVar GhcRn
_ flag
fl (L SrcSpan
_ IdP GhcRn
nm) LHsType GhcRn
ki))
  = do { Core Name
nm' <- Name -> MetaM (Core Name)
lookupBinder Name
IdP GhcRn
nm
       ; Core (M Type)
ki' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ki
       ; Core Name
-> flag -> Core (M Type) -> MetaM (Core (M (TyVarBndr flag')))
forall flag flag'.
RepTV flag flag' =>
Core Name
-> flag -> Core (M Type) -> MetaM (Core (M (TyVarBndr flag')))
repKindedTV Core Name
nm' flag
fl Core (M Type)
ki' }

-- represent a type context
--
repLContext :: LHsContext GhcRn -> MetaM (Core (M TH.Cxt))
repLContext :: LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
ctxt = HsContext GhcRn -> MetaM (Core (M Cxt))
repContext (LHsContext GhcRn -> HsContext GhcRn
forall l e. GenLocated l e -> e
unLoc LHsContext GhcRn
ctxt)

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

repHsSigType :: LHsSigType GhcRn -> MetaM (Core (M TH.Type))
repHsSigType :: LHsSigType GhcRn -> MetaM (Core (M Type))
repHsSigType (HsIB { hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
hsib_ext = XHsIB GhcRn (LHsType GhcRn)
implicit_tvs
                   , hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcRn
body })
  | ([LHsTyVarBndr Specificity GhcRn]
explicit_tvs, LHsContext GhcRn
ctxt, LHsType GhcRn
ty) <- LHsType GhcRn
-> ([LHsTyVarBndr Specificity GhcRn], LHsContext GhcRn,
    LHsType GhcRn)
forall pass.
LHsType pass
-> ([LHsTyVarBndr Specificity pass], LHsContext pass, LHsType pass)
splitLHsSigmaTyInvis LHsType GhcRn
body
  = [Name] -> MetaM (Core (M Type)) -> MetaM (Core (M Type))
forall a. [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds [Name]
XHsIB GhcRn (LHsType GhcRn)
implicit_tvs (MetaM (Core (M Type)) -> MetaM (Core (M Type)))
-> MetaM (Core (M Type)) -> MetaM (Core (M Type))
forall a b. (a -> b) -> a -> b
$
      -- See Note [Don't quantify implicit type variables in quotes]
    [LHsTyVarBndr Specificity GhcRn]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall flag flag' a.
RepTV flag flag' =>
[LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds [LHsTyVarBndr Specificity GhcRn]
explicit_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)]
th_explicit_tvs ->
    do { Core (M Cxt)
th_ctxt <- LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
ctxt
       ; Core (M Type)
th_ty   <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ty
       ; if [LHsTyVarBndr Specificity GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity GhcRn]
explicit_tvs Bool -> Bool -> Bool
&& HsContext GhcRn -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LHsContext GhcRn -> HsContext GhcRn
forall l e. GenLocated l e -> e
unLoc LHsContext GhcRn
ctxt)
         then Core (M Type) -> MetaM (Core (M Type))
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Type)
th_ty
         else Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
th_explicit_tvs Core (M Cxt)
th_ctxt Core (M Type)
th_ty }

-- yield the representation of a list of types
repLTys :: [LHsType GhcRn] -> MetaM [Core (M TH.Type)]
repLTys :: HsContext GhcRn -> MetaM [Core (M Type)]
repLTys HsContext GhcRn
tys = (LHsType GhcRn -> MetaM (Core (M Type)))
-> HsContext GhcRn -> MetaM [Core (M Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsType GhcRn -> MetaM (Core (M Type))
repLTy HsContext GhcRn
tys

-- represent a type
repLTy :: LHsType GhcRn -> MetaM (Core (M TH.Type))
repLTy :: LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ty = HsType GhcRn -> MetaM (Core (M Type))
repTy (LHsType GhcRn -> HsType GhcRn
forall l e. GenLocated l e -> e
unLoc LHsType GhcRn
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 GhcRn -> MetaM (Core (M Type))
repForallT HsType GhcRn
ty
 | ([LHsTyVarBndr Specificity GhcRn]
tvs, LHsContext GhcRn
ctxt, LHsType GhcRn
tau) <- LHsType GhcRn
-> ([LHsTyVarBndr Specificity GhcRn], LHsContext GhcRn,
    LHsType GhcRn)
forall pass.
LHsType pass
-> ([LHsTyVarBndr Specificity pass], LHsContext pass, LHsType pass)
splitLHsSigmaTyInvis (HsType GhcRn -> LHsType GhcRn
forall e. e -> Located e
noLoc HsType GhcRn
ty)
 = [LHsTyVarBndr Specificity GhcRn]
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall flag flag' a.
RepTV flag flag' =>
[LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds [LHsTyVarBndr Specificity GhcRn]
tvs ((Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
 -> MetaM (Core (M Type)))
-> (Core [M (TyVarBndr Specificity)] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr Specificity)]
bndrs ->
   do { Core (M Cxt)
ctxt1  <- LHsContext GhcRn -> MetaM (Core (M Cxt))
repLContext LHsContext GhcRn
ctxt
      ; Core (M Type)
tau1   <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
tau
      ; Core [M (TyVarBndr Specificity)]
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Type))
repTForall Core [M (TyVarBndr Specificity)]
bndrs Core (M Cxt)
ctxt1 Core (M Type)
tau1 -- forall a. C a => {...}
      }

repTy :: HsType GhcRn -> MetaM (Core (M TH.Type))
repTy :: HsType GhcRn -> MetaM (Core (M Type))
repTy ty :: HsType GhcRn
ty@(HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllTelescope GhcRn
tele, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcRn
body }) =
  case HsForAllTelescope GhcRn
tele of
    HsForAllInvis{} -> HsType GhcRn -> MetaM (Core (M Type))
repForallT HsType GhcRn
ty
    HsForAllVis { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () GhcRn]
tvs } ->
      [LHsTyVarBndr () GhcRn]
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall flag flag' a.
RepTV flag flag' =>
[LHsTyVarBndr flag GhcRn]
-> (Core [M (TyVarBndr flag')] -> MetaM (Core (M a)))
-> MetaM (Core (M a))
addHsTyVarBinds [LHsTyVarBndr () GhcRn]
tvs ((Core [M (TyVarBndr ())] -> MetaM (Core (M Type)))
 -> MetaM (Core (M Type)))
-> (Core [M (TyVarBndr ())] -> MetaM (Core (M Type)))
-> MetaM (Core (M Type))
forall a b. (a -> b) -> a -> b
$ \Core [M (TyVarBndr ())]
bndrs ->
      do Core (M Type)
body1 <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
body
         Core [M (TyVarBndr ())] -> Core (M Type) -> MetaM (Core (M Type))
repTForallVis Core [M (TyVarBndr ())]
bndrs Core (M Type)
body1
repTy ty :: HsType GhcRn
ty@(HsQualTy {}) = HsType GhcRn -> MetaM (Core (M Type))
repForallT HsType GhcRn
ty

repTy (HsTyVar XTyVar GhcRn
_ PromotionFlag
_ (L SrcSpan
_ IdP GhcRn
n))
  | Name -> Bool
isLiftedTypeKindTyConName Name
IdP GhcRn
n        = MetaM (Core (M Type))
repTStar
  | Name
IdP GhcRn
n Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
constraintKindTyConKey  = MetaM (Core (M Type))
repTConstraint
  | Name
IdP GhcRn
n Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
unrestrictedFunTyConKey = MetaM (Core (M Type))
repArrowTyCon
  | Name
IdP GhcRn
n Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
funTyConKey             = MetaM (Core (M Type))
repMulArrowTyCon
  | OccName -> Bool
isTvOcc OccName
occ   = do Core Name
tv1 <- Name -> MetaM (Core Name)
lookupOcc Name
IdP GhcRn
n
                       Core Name -> MetaM (Core (M Type))
repTvar Core Name
tv1
  | OccName -> Bool
isDataOcc OccName
occ = do Core Name
tc1 <- Name -> MetaM (Core Name)
lookupOcc Name
IdP GhcRn
n
                       Core Name -> MetaM (Core (M Type))
repPromotedDataCon Core Name
tc1
  | Name
IdP GhcRn
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
eqTyConName = MetaM (Core (M Type))
repTequality
  | Bool
otherwise     = do Core Name
tc1 <- Name -> MetaM (Core Name)
lookupOcc Name
IdP GhcRn
n
                       Core Name -> MetaM (Core (M Type))
repNamedTyCon Core Name
tc1
  where
    occ :: OccName
occ = Name -> OccName
nameOccName Name
IdP GhcRn
n

repTy (HsAppTy XAppTy GhcRn
_ LHsType GhcRn
f LHsType GhcRn
a)       = do
                                Core (M Type)
f1 <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
f
                                Core (M Type)
a1 <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
a
                                Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
f1 Core (M Type)
a1
repTy (HsAppKindTy XAppKindTy GhcRn
_ LHsType GhcRn
ty LHsType GhcRn
ki) = do
                                Core (M Type)
ty1 <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ty
                                Core (M Type)
ki1 <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
ki
                                Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTappKind Core (M Type)
ty1 Core (M Type)
ki1
repTy (HsFunTy XFunTy GhcRn
_ HsArrow GhcRn
w LHsType GhcRn
f LHsType GhcRn
a) | HsArrow GhcRn -> Bool
isUnrestricted HsArrow GhcRn
w = do
                                Core (M Type)
f1   <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
f
                                Core (M Type)
a1   <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
a
                                Core (M Type)
tcon <- MetaM (Core (M Type))
repArrowTyCon
                                Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)
f1, Core (M Type)
a1]
repTy (HsFunTy XFunTy GhcRn
_ HsArrow GhcRn
w LHsType GhcRn
f LHsType GhcRn
a) = do Core (M Type)
w1   <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy (HsArrow GhcRn -> LHsType GhcRn
arrowToHsType HsArrow GhcRn
w)
                             Core (M Type)
f1   <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
f
                             Core (M Type)
a1   <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
a
                             Core (M Type)
tcon <- MetaM (Core (M Type))
repMulArrowTyCon
                             Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)
w1, Core (M Type)
f1, Core (M Type)
a1]
repTy (HsListTy XListTy GhcRn
_ LHsType GhcRn
t)        = do
                                Core (M Type)
t1   <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
t
                                Core (M Type)
tcon <- MetaM (Core (M Type))
repListTyCon
                                Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
tcon Core (M Type)
t1
repTy (HsTupleTy XTupleTy GhcRn
_ HsTupleSort
HsUnboxedTuple HsContext GhcRn
tys) = do
                                [Core (M Type)]
tys1 <- HsContext GhcRn -> MetaM [Core (M Type)]
repLTys HsContext GhcRn
tys
                                Core (M Type)
tcon <- Int -> MetaM (Core (M Type))
repUnboxedTupleTyCon (HsContext GhcRn -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HsContext GhcRn
tys)
                                Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)]
tys1
repTy (HsTupleTy XTupleTy GhcRn
_ HsTupleSort
_ HsContext GhcRn
tys)   = do [Core (M Type)]
tys1 <- HsContext GhcRn -> MetaM [Core (M Type)]
repLTys HsContext GhcRn
tys
                                 Core (M Type)
tcon <- Int -> MetaM (Core (M Type))
repTupleTyCon (HsContext GhcRn -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HsContext GhcRn
tys)
                                 Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)]
tys1
repTy (HsSumTy XSumTy GhcRn
_ HsContext GhcRn
tys)       = do [Core (M Type)]
tys1 <- HsContext GhcRn -> MetaM [Core (M Type)]
repLTys HsContext GhcRn
tys
                                 Core (M Type)
tcon <- Int -> MetaM (Core (M Type))
repUnboxedSumTyCon (HsContext GhcRn -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HsContext GhcRn
tys)
                                 Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)]
tys1
repTy (HsOpTy XOpTy GhcRn
_ LHsType GhcRn
ty1 Located (IdP GhcRn)
n LHsType GhcRn
ty2)  = LHsType GhcRn -> MetaM (Core (M Type))
repLTy ((IdP GhcRn -> LHsType GhcRn
forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
Located (IdP GhcRn)
n) LHsType GhcRn -> LHsType GhcRn -> LHsType GhcRn
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy` LHsType GhcRn
ty1)
                                   LHsType GhcRn -> LHsType GhcRn -> LHsType GhcRn
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy` LHsType GhcRn
ty2)
repTy (HsParTy XParTy GhcRn
_ LHsType GhcRn
t)         = LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
t
repTy (HsStarTy XStarTy GhcRn
_ Bool
_) =  MetaM (Core (M Type))
repTStar
repTy (HsKindSig XKindSig GhcRn
_ LHsType GhcRn
t LHsType GhcRn
k)     = do
                                Core (M Type)
t1 <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
t
                                Core (M Type)
k1 <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
k
                                Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTSig Core (M Type)
t1 Core (M Type)
k1
repTy (HsSpliceTy XSpliceTy GhcRn
_ HsSplice GhcRn
splice)      = HsSplice GhcRn -> MetaM (Core (M Type))
forall a. HsSplice GhcRn -> MetaM (Core a)
repSplice HsSplice GhcRn
splice
repTy (HsExplicitListTy XExplicitListTy GhcRn
_ PromotionFlag
_ HsContext GhcRn
tys) = do
                                    [Core (M Type)]
tys1 <- HsContext GhcRn -> MetaM [Core (M Type)]
repLTys HsContext GhcRn
tys
                                    [Core (M Type)] -> MetaM (Core (M Type))
repTPromotedList [Core (M Type)]
tys1
repTy (HsExplicitTupleTy XExplicitTupleTy GhcRn
_ HsContext GhcRn
tys) = do
                                    [Core (M Type)]
tys1 <- HsContext GhcRn -> MetaM [Core (M Type)]
repLTys HsContext GhcRn
tys
                                    Core (M Type)
tcon <- Int -> MetaM (Core (M Type))
repPromotedTupleTyCon (HsContext GhcRn -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HsContext GhcRn
tys)
                                    Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
tcon [Core (M Type)]
tys1
repTy (HsTyLit XTyLit GhcRn
_ HsTyLit
lit) = do
                          Core (M TyLit)
lit' <- HsTyLit -> MetaM (Core (M TyLit))
repTyLit HsTyLit
lit
                          Core (M TyLit) -> MetaM (Core (M Type))
repTLit Core (M TyLit)
lit'
repTy (HsWildCardTy XWildCardTy GhcRn
_) = MetaM (Core (M Type))
repTWildCard
repTy (HsIParamTy XIParamTy GhcRn
_ Located HsIPName
n LHsType GhcRn
t) = do
                             Core String
n' <- HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name (Located HsIPName -> HsIPName
forall l e. GenLocated l e -> e
unLoc Located HsIPName
n)
                             Core (M Type)
t' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
t
                             Core String -> Core (M Type) -> MetaM (Core (M Type))
repTImplicitParam Core String
n' Core (M Type)
t'

repTy HsType GhcRn
ty                      = String -> SDoc -> MetaM (Core (M Type))
forall a. String -> SDoc -> MetaM a
notHandled String
"Exotic form of type" (HsType GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
ty)

repTyLit :: HsTyLit -> MetaM (Core (M TH.TyLit))
repTyLit :: HsTyLit -> MetaM (Core (M TyLit))
repTyLit (HsNumTy SourceText
_ Integer
i) = Name -> [CoreExpr] -> MetaM (Core (M TyLit))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
numTyLitName [Integer -> CoreExpr
mkIntegerExpr Integer
i]
repTyLit (HsStrTy SourceText
_ CLabelString
s) = do { CoreExpr
s' <- CLabelString -> ReaderT MetaWrappers DsM CoreExpr
forall (m :: * -> *). MonadThings m => CLabelString -> m CoreExpr
mkStringExprFS CLabelString
s
                            ; Name -> [CoreExpr] -> MetaM (Core (M TyLit))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
strTyLitName [CoreExpr
s']
                            }

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

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

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

repSplice :: HsSplice GhcRn -> MetaM (Core a)
-- 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
repSplice :: forall a. HsSplice GhcRn -> MetaM (Core a)
repSplice (HsTypedSplice   XTypedSplice GhcRn
_ SpliceDecoration
_ IdP GhcRn
n LHsExpr GhcRn
_) = Name -> MetaM (Core a)
forall a. Name -> MetaM (Core a)
rep_splice Name
IdP GhcRn
n
repSplice (HsUntypedSplice XUntypedSplice GhcRn
_ SpliceDecoration
_ IdP GhcRn
n LHsExpr GhcRn
_) = Name -> MetaM (Core a)
forall a. Name -> MetaM (Core a)
rep_splice Name
IdP GhcRn
n
repSplice (HsQuasiQuote XQuasiQuote GhcRn
_ IdP GhcRn
n IdP GhcRn
_ SrcSpan
_ CLabelString
_)  = Name -> MetaM (Core a)
forall a. Name -> MetaM (Core a)
rep_splice Name
IdP GhcRn
n
repSplice e :: HsSplice GhcRn
e@(HsSpliced {})          = String -> SDoc -> MetaM (Core a)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repSplice" (HsSplice GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsSplice GhcRn
e)

rep_splice :: Name -> MetaM (Core a)
rep_splice :: forall a. Name -> MetaM (Core a)
rep_splice Name
splice_name
 = do { Maybe DsMetaVal
mb_val <- IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
-> ReaderT MetaWrappers DsM (Maybe DsMetaVal)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
 -> ReaderT MetaWrappers DsM (Maybe DsMetaVal))
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
-> ReaderT MetaWrappers DsM (Maybe DsMetaVal)
forall a b. (a -> b) -> a -> b
$ Name -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
dsLookupMetaEnv Name
splice_name
       ; case Maybe DsMetaVal
mb_val of
           Just (DsSplice HsExpr GhcTc
e) -> do { CoreExpr
e' <- DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr)
-> DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ HsExpr GhcTc -> DsM CoreExpr
dsExpr HsExpr GhcTc
e
                                   ; Core a -> MetaM (Core a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core a
forall a. CoreExpr -> Core a
MkC CoreExpr
e') }
           Maybe DsMetaVal
_ -> String -> SDoc -> MetaM (Core a)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"HsSplice" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
splice_name) }
                        -- Should not happen; statically checked

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

repLEs :: [LHsExpr GhcRn] -> MetaM (Core [(M TH.Exp)])
repLEs :: [LHsExpr GhcRn] -> MetaM (Core [M Exp])
repLEs [LHsExpr GhcRn]
es = Name
-> (LHsExpr GhcRn -> MetaM (Core (M Exp)))
-> [LHsExpr GhcRn]
-> MetaM (Core [M Exp])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
expTyConName LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE [LHsExpr GhcRn]
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 GhcRn -> MetaM (Core (M Exp))
repLE (L SrcSpan
loc HsExpr GhcRn
e) = (IOEnv (Env DsGblEnv DsLclEnv) (Core (M Exp))
 -> IOEnv (Env DsGblEnv DsLclEnv) (Core (M Exp)))
-> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (SrcSpan
-> IOEnv (Env DsGblEnv DsLclEnv) (Core (M Exp))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core (M Exp))
forall a. SrcSpan -> DsM a -> DsM a
putSrcSpanDs SrcSpan
loc) (HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
e)

repE :: HsExpr GhcRn -> MetaM (Core (M TH.Exp))
repE :: HsExpr GhcRn -> MetaM (Core (M Exp))
repE (HsVar XVar GhcRn
_ (L SrcSpan
_ IdP GhcRn
x)) =
  do { Maybe DsMetaVal
mb_val <- IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
-> ReaderT MetaWrappers DsM (Maybe DsMetaVal)
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
IdP GhcRn
x
     ; case Maybe DsMetaVal
mb_val of
        Maybe DsMetaVal
Nothing            -> do { Core Name
str <- DsM (Core Name) -> MetaM (Core Name)
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
IdP GhcRn
x
                                 ; Name -> Core Name -> MetaM (Core (M Exp))
repVarOrCon Name
IdP GhcRn
x Core Name
str }
        Just (DsBound Id
y)   -> Name -> Core Name -> MetaM (Core (M Exp))
repVarOrCon Name
IdP GhcRn
x (Id -> Core Name
coreVar Id
y)
        Just (DsSplice HsExpr GhcTc
e)  -> do { CoreExpr
e' <- DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr)
-> DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ HsExpr GhcTc -> DsM CoreExpr
dsExpr HsExpr GhcTc
e
                                 ; Core (M Exp) -> MetaM (Core (M Exp))
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core (M Exp)
forall a. CoreExpr -> Core a
MkC CoreExpr
e') } }
repE (HsIPVar XIPVar GhcRn
_ HsIPName
n) = HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name HsIPName
n ReaderT MetaWrappers DsM (Core String)
-> (Core String -> MetaM (Core (M Exp))) -> MetaM (Core (M Exp))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Core String -> MetaM (Core (M Exp))
repImplicitParamVar
repE (HsOverLabel XOverLabel GhcRn
_ Maybe (IdP GhcRn)
_ CLabelString
s) = CLabelString -> MetaM (Core (M Exp))
repOverLabel CLabelString
s

repE e :: HsExpr GhcRn
e@(HsRecFld XRecFld GhcRn
_ AmbiguousFieldOcc GhcRn
f) = case AmbiguousFieldOcc GhcRn
f of
  Unambiguous XUnambiguous GhcRn
x Located RdrName
_ -> HsExpr GhcRn -> MetaM (Core (M Exp))
repE (XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (Name -> Located Name
forall e. e -> Located e
noLoc Name
XUnambiguous GhcRn
x))
  Ambiguous{}     -> String -> SDoc -> MetaM (Core (M Exp))
forall a. String -> SDoc -> MetaM a
notHandled String
"Ambiguous record selectors" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)

        -- Remember, we're desugaring renamer output here, so
        -- HsOverlit can definitely occur
repE (HsOverLit XOverLitE GhcRn
_ HsOverLit GhcRn
l) = do { Core Lit
a <- HsOverLit GhcRn -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit GhcRn
l; Core Lit -> MetaM (Core (M Exp))
repLit Core Lit
a }
repE (HsLit XLitE GhcRn
_ HsLit GhcRn
l)     = do { Core Lit
a <- HsLit GhcRn -> MetaM (Core Lit)
repLiteral HsLit GhcRn
l;           Core Lit -> MetaM (Core (M Exp))
repLit Core Lit
a }
repE (HsLam XLam GhcRn
_ (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = (L SrcSpan
_ [LMatch GhcRn (LHsExpr GhcRn)
m]) })) = LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M Exp))
repLambda LMatch GhcRn (LHsExpr GhcRn)
m
repE (HsLamCase XLamCase GhcRn
_ (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = (L SrcSpan
_ [LMatch GhcRn (LHsExpr GhcRn)]
ms) }))
                   = do { [Core (M Match)]
ms' <- (LMatch GhcRn (LHsExpr GhcRn)
 -> ReaderT MetaWrappers DsM (Core (M Match)))
-> [LMatch GhcRn (LHsExpr GhcRn)]
-> ReaderT MetaWrappers DsM [Core (M Match)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatchTup [LMatch GhcRn (LHsExpr GhcRn)]
ms
                        ; Core [M Match]
core_ms <- Name -> [Core (M Match)] -> MetaM (Core [M Match])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
matchTyConName [Core (M Match)]
ms'
                        ; Core [M Match] -> MetaM (Core (M Exp))
repLamCase Core [M Match]
core_ms }
repE (HsApp XApp GhcRn
_ LHsExpr GhcRn
x LHsExpr GhcRn
y)   = do {Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x; Core (M Exp)
b <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
y; Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repApp Core (M Exp)
a Core (M Exp)
b}
repE (HsAppType XAppTypeE GhcRn
_ LHsExpr GhcRn
e LHsWcType (NoGhcTc GhcRn)
t) = do { Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
                            ; Core (M Type)
s <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy (HsWildCardBndrs GhcRn (LHsType GhcRn) -> LHsType GhcRn
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcRn (LHsType GhcRn)
LHsWcType (NoGhcTc GhcRn)
t)
                            ; Core (M Exp) -> Core (M Type) -> MetaM (Core (M Exp))
repAppType Core (M Exp)
a Core (M Type)
s }

repE (OpApp XOpApp GhcRn
_ LHsExpr GhcRn
e1 LHsExpr GhcRn
op LHsExpr GhcRn
e2) =
  do { Core (M Exp)
arg1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e1;
       Core (M Exp)
arg2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e2;
       Core (M Exp)
the_op <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
op ;
       Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repInfixApp Core (M Exp)
arg1 Core (M Exp)
the_op Core (M Exp)
arg2 }
repE (NegApp XNegApp GhcRn
_ LHsExpr GhcRn
x SyntaxExpr GhcRn
_)      = do
                              Core (M Exp)
a         <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x
                              Core (M Exp)
negateVar <- Name -> MetaM (Core Name)
lookupOcc Name
negateName MetaM (Core Name)
-> (Core Name -> MetaM (Core (M Exp))) -> MetaM (Core (M Exp))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Core Name -> MetaM (Core (M Exp))
repVar
                              Core (M Exp)
negateVar Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
`repApp` Core (M Exp)
a
repE (HsPar XPar GhcRn
_ LHsExpr GhcRn
x)            = LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x
repE (SectionL XSectionL GhcRn
_ LHsExpr GhcRn
x LHsExpr GhcRn
y)       = do { Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x; Core (M Exp)
b <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
y; Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repSectionL Core (M Exp)
a Core (M Exp)
b }
repE (SectionR XSectionR GhcRn
_ LHsExpr GhcRn
x LHsExpr GhcRn
y)       = do { Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x; Core (M Exp)
b <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
y; Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repSectionR Core (M Exp)
a Core (M Exp)
b }
repE (HsCase XCase GhcRn
_ LHsExpr GhcRn
e (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = (L SrcSpan
_ [LMatch GhcRn (LHsExpr GhcRn)]
ms) }))
                          = do { Core (M Exp)
arg <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
                               ; [Core (M Match)]
ms2 <- (LMatch GhcRn (LHsExpr GhcRn)
 -> ReaderT MetaWrappers DsM (Core (M Match)))
-> [LMatch GhcRn (LHsExpr GhcRn)]
-> ReaderT MetaWrappers DsM [Core (M Match)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatchTup [LMatch GhcRn (LHsExpr GhcRn)]
ms
                               ; Core [M Match]
core_ms2 <- Name -> [Core (M Match)] -> MetaM (Core [M Match])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
matchTyConName [Core (M Match)]
ms2
                               ; Core (M Exp) -> Core [M Match] -> MetaM (Core (M Exp))
repCaseE Core (M Exp)
arg Core [M Match]
core_ms2 }
repE (HsIf XIf GhcRn
_ LHsExpr GhcRn
x LHsExpr GhcRn
y LHsExpr GhcRn
z)       = do
                            Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
x
                            Core (M Exp)
b <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
y
                            Core (M Exp)
c <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
z
                            Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repCond Core (M Exp)
a Core (M Exp)
b Core (M Exp)
c
repE (HsMultiIf XMultiIf GhcRn
_ [LGRHS GhcRn (LHsExpr GhcRn)]
alts)
  = do { ([[GenSymBind]]
binds, [Core (M (Guard, Exp))]
alts') <- ([([GenSymBind], Core (M (Guard, Exp)))]
 -> ([[GenSymBind]], [Core (M (Guard, Exp))]))
-> ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
-> ReaderT
     MetaWrappers DsM ([[GenSymBind]], [Core (M (Guard, Exp))])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [([GenSymBind], Core (M (Guard, Exp)))]
-> ([[GenSymBind]], [Core (M (Guard, Exp))])
forall a b. [(a, b)] -> ([a], [b])
unzip (ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
 -> ReaderT
      MetaWrappers DsM ([[GenSymBind]], [Core (M (Guard, Exp))]))
-> ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
-> ReaderT
     MetaWrappers DsM ([[GenSymBind]], [Core (M (Guard, Exp))])
forall a b. (a -> b) -> a -> b
$ (LGRHS GhcRn (LHsExpr GhcRn)
 -> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp))))
-> [LGRHS GhcRn (LHsExpr GhcRn)]
-> ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LGRHS GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
repLGRHS [LGRHS GhcRn (LHsExpr GhcRn)]
alts
       ; Core (M Exp)
expr' <- Core [M (Guard, Exp)] -> MetaM (Core (M Exp))
repMultiIf ([Core (M (Guard, Exp))] -> Core [M (Guard, Exp)]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M (Guard, Exp))]
alts')
       ; [GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms ([[GenSymBind]] -> [GenSymBind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenSymBind]]
binds) Core (M Exp)
expr' }
repE (HsLet XLet GhcRn
_ (L SrcSpan
_ HsLocalBinds GhcRn
bs) LHsExpr GhcRn
e)       = do { ([GenSymBind]
ss,Core [M Dec]
ds) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
bs
                                     ; Core (M Exp)
e2 <- [GenSymBind] -> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e)
                                     ; Core (M Exp)
z <- Core [M Dec] -> Core (M Exp) -> MetaM (Core (M Exp))
repLetE Core [M Dec]
ds Core (M Exp)
e2
                                     ; [GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
z }

-- FIXME: I haven't got the types here right yet
repE e :: HsExpr GhcRn
e@(HsDo XDo GhcRn
_ HsStmtContext GhcRn
ctxt (L SrcSpan
_ [ExprLStmt GhcRn]
sts))
 | Just Maybe ModuleName
maybeModuleName <- case HsStmtContext GhcRn
ctxt of
     { DoExpr Maybe ModuleName
m -> Maybe ModuleName -> Maybe (Maybe ModuleName)
forall a. a -> Maybe a
Just Maybe ModuleName
m; HsStmtContext GhcRn
GhciStmtCtxt -> Maybe ModuleName -> Maybe (Maybe ModuleName)
forall a. a -> Maybe a
Just Maybe ModuleName
forall a. Maybe a
Nothing; HsStmtContext GhcRn
_ -> Maybe (Maybe ModuleName)
forall a. Maybe a
Nothing }
 = do { ([GenSymBind]
ss,[Core (M Stmt)]
zs) <- [ExprLStmt GhcRn] -> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt GhcRn]
sts;
        Core (M Exp)
e'      <- Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoE Maybe ModuleName
maybeModuleName ([Core (M Stmt)] -> Core [M Stmt]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Stmt)]
zs);
        [GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
e' }

 | HsStmtContext GhcRn
ListComp <- HsStmtContext GhcRn
ctxt
 = do { ([GenSymBind]
ss,[Core (M Stmt)]
zs) <- [ExprLStmt GhcRn] -> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt GhcRn]
sts;
        Core (M Exp)
e'      <- Core [M Stmt] -> MetaM (Core (M Exp))
repComp ([Core (M Stmt)] -> Core [M Stmt]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Stmt)]
zs);
        [GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
e' }

 | MDoExpr Maybe ModuleName
maybeModuleName <- HsStmtContext GhcRn
ctxt
 = do { ([GenSymBind]
ss,[Core (M Stmt)]
zs) <- [ExprLStmt GhcRn] -> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt GhcRn]
sts;
        Core (M Exp)
e'      <- Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repMDoE Maybe ModuleName
maybeModuleName ([Core (M Stmt)] -> Core [M Stmt]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Stmt)]
zs);
        [GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
e' }

  | Bool
otherwise
  = String -> SDoc -> MetaM (Core (M Exp))
forall a. String -> SDoc -> MetaM a
notHandled String
"monad comprehension and [: :]" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)

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

  in do { [Core (Maybe (M Exp))]
args <- (LHsTupArg GhcRn -> MetaM (Core (Maybe (M Exp))))
-> [LHsTupArg GhcRn]
-> ReaderT MetaWrappers DsM [Core (Maybe (M Exp))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsTupArg GhcRn -> MetaM (Core (Maybe (M Exp)))
tupArgToCoreExp [LHsTupArg GhcRn]
es
        ; Type
expTy <- Name -> MetaM Type
wrapName  Name
expTyConName
        ; let maybeExpQTy :: Type
maybeExpQTy = TyCon -> [Type] -> Type
mkTyConApp TyCon
maybeTyCon [Type
expTy]
              listArg :: Core [Maybe (M Exp)]
listArg = Type -> [Core (Maybe (M Exp))] -> Core [Maybe (M Exp)]
forall a. Type -> [Core a] -> Core [a]
coreList' Type
maybeExpQTy [Core (Maybe (M Exp))]
args
        ; if Boxity -> Bool
isBoxed Boxity
boxity
          then Core [Maybe (M Exp)] -> MetaM (Core (M Exp))
repTup Core [Maybe (M Exp)]
listArg
          else Core [Maybe (M Exp)] -> MetaM (Core (M Exp))
repUnboxedTup Core [Maybe (M Exp)]
listArg }

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

repE (RecordCon { rcon_con_name :: forall p. HsExpr p -> Located (IdP p)
rcon_con_name = Located (IdP GhcRn)
c, rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = HsRecordBinds GhcRn
flds })
 = do { Core Name
x <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
c;
        Core [M FieldExp]
fs <- HsRecordBinds GhcRn -> MetaM (Core [M FieldExp])
repFields HsRecordBinds GhcRn
flds;
        Core Name -> Core [M FieldExp] -> MetaM (Core (M Exp))
repRecCon Core Name
x Core [M FieldExp]
fs }
repE (RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr GhcRn
e, rupd_flds :: forall p. HsExpr p -> [LHsRecUpdField p]
rupd_flds = [LHsRecUpdField GhcRn]
flds })
 = do { Core (M Exp)
x <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e;
        Core [M FieldExp]
fs <- [LHsRecUpdField GhcRn] -> MetaM (Core [M FieldExp])
repUpdFields [LHsRecUpdField GhcRn]
flds;
        Core (M Exp) -> Core [M FieldExp] -> MetaM (Core (M Exp))
repRecUpd Core (M Exp)
x Core [M FieldExp]
fs }

repE (ExprWithTySig XExprWithTySig GhcRn
_ LHsExpr GhcRn
e LHsSigWcType (NoGhcTc GhcRn)
wc_ty)
  = [Name] -> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a. [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds (LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig LHsSigType GhcRn
sig_ty) (MetaM (Core (M Exp)) -> MetaM (Core (M Exp)))
-> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a b. (a -> b) -> a -> b
$
    do { Core (M Exp)
e1 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
       ; Core (M Type)
t1 <- LHsSigType GhcRn -> MetaM (Core (M Type))
rep_ty_sig' LHsSigType GhcRn
sig_ty
       ; Core (M Exp) -> Core (M Type) -> MetaM (Core (M Exp))
repSigExp Core (M Exp)
e1 Core (M Type)
t1 }
  where
    sig_ty :: LHsSigType GhcRn
sig_ty = LHsSigWcType GhcRn -> LHsSigType GhcRn
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType GhcRn
LHsSigWcType (NoGhcTc GhcRn)
wc_ty

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

repE (HsSpliceE XSpliceE GhcRn
_ HsSplice GhcRn
splice)  = HsSplice GhcRn -> MetaM (Core (M Exp))
forall a. HsSplice GhcRn -> MetaM (Core a)
repSplice HsSplice GhcRn
splice
repE (HsStatic XStatic GhcRn
_ LHsExpr GhcRn
e)        = LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e MetaM (Core (M Exp))
-> (Core (M Exp) -> MetaM (Core (M Exp))) -> MetaM (Core (M Exp))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
staticEName ([CoreExpr] -> MetaM (Core (M Exp)))
-> (Core (M Exp) -> [CoreExpr])
-> Core (M Exp)
-> MetaM (Core (M Exp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoreExpr -> [CoreExpr] -> [CoreExpr]
forall a. a -> [a] -> [a]
:[]) (CoreExpr -> [CoreExpr])
-> (Core (M Exp) -> CoreExpr) -> Core (M Exp) -> [CoreExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Core (M Exp) -> CoreExpr
forall a. Core a -> CoreExpr
unC
repE (HsUnboundVar XUnboundVar GhcRn
_ OccName
uv)   = do
                               Core String
occ   <- OccName -> ReaderT MetaWrappers DsM (Core String)
occNameLit OccName
uv
                               Core Name
sname <- Core String -> MetaM (Core Name)
repNameS Core String
occ
                               Core Name -> MetaM (Core (M Exp))
repUnboundVar Core Name
sname
repE (XExpr (HsExpanded HsExpr GhcRn
_ HsExpr GhcRn
b))        = HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
b
repE e :: HsExpr GhcRn
e@(HsPragE XPragE GhcRn
_ HsPragSCC  {} LHsExpr GhcRn
_)   = String -> SDoc -> MetaM (Core (M Exp))
forall a. String -> SDoc -> MetaM a
notHandled String
"Cost centres" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)
repE e :: HsExpr GhcRn
e@(HsPragE XPragE GhcRn
_ HsPragTick {} LHsExpr GhcRn
_)   = String -> SDoc -> MetaM (Core (M Exp))
forall a. String -> SDoc -> MetaM a
notHandled String
"Tick Pragma" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)
repE HsExpr GhcRn
e                     = String -> SDoc -> MetaM (Core (M Exp))
forall a. String -> SDoc -> MetaM a
notHandled String
"Expression form" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)

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

repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Match))
repMatchTup :: LMatch GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatchTup (L SrcSpan
_ (Match { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcRn
p]
                        , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs GhcRn (LHsExpr GhcRn)
_ [LGRHS GhcRn (LHsExpr GhcRn)]
guards (L SrcSpan
_ HsLocalBinds GhcRn
wheres) })) =
  do { [GenSymBind]
ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms (LPat GhcRn -> [IdP GhcRn]
forall p. CollectPass p => LPat p -> [IdP p]
collectPatBinders LPat GhcRn
p)
     ; [GenSymBind]
-> ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 (ReaderT MetaWrappers DsM (Core (M Match))
 -> ReaderT MetaWrappers DsM (Core (M Match)))
-> ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match))
forall a b. (a -> b) -> a -> b
$ do {
     ; Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
     ; ([GenSymBind]
ss2,Core [M Dec]
ds) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
wheres
     ; [GenSymBind]
-> ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss2 (ReaderT MetaWrappers DsM (Core (M Match))
 -> ReaderT MetaWrappers DsM (Core (M Match)))
-> ReaderT MetaWrappers DsM (Core (M Match))
-> ReaderT MetaWrappers DsM (Core (M Match))
forall a b. (a -> b) -> a -> b
$ do {
     ; Core (M Body)
gs    <- [LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
guards
     ; Core (M Match)
match <- Core (M Pat)
-> Core (M Body)
-> Core [M Dec]
-> ReaderT MetaWrappers DsM (Core (M Match))
repMatch Core (M Pat)
p1 Core (M Body)
gs Core [M Dec]
ds
     ; [GenSymBind]
-> Core (M Match) -> ReaderT MetaWrappers DsM (Core (M Match))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2) Core (M Match)
match }}}
repMatchTup LMatch GhcRn (LHsExpr GhcRn)
_ = String -> ReaderT MetaWrappers DsM (Core (M Match))
forall a. String -> a
panic String
"repMatchTup: case alt with more than one arg"

repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Clause))
repClauseTup :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M Clause))
repClauseTup (L SrcSpan
_ (Match { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcRn]
ps
                         , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs GhcRn (LHsExpr GhcRn)
_ [LGRHS GhcRn (LHsExpr GhcRn)]
guards (L SrcSpan
_ HsLocalBinds GhcRn
wheres) })) =
  do { [GenSymBind]
ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms ([LPat GhcRn] -> [IdP GhcRn]
forall p. CollectPass p => [LPat p] -> [IdP p]
collectPatsBinders [LPat GhcRn]
ps)
     ; [GenSymBind] -> MetaM (Core (M Clause)) -> MetaM (Core (M Clause))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 (MetaM (Core (M Clause)) -> MetaM (Core (M Clause)))
-> MetaM (Core (M Clause)) -> MetaM (Core (M Clause))
forall a b. (a -> b) -> a -> b
$ do {
       Core [M Pat]
ps1 <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps
     ; ([GenSymBind]
ss2,Core [M Dec]
ds) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
wheres
     ; [GenSymBind] -> MetaM (Core (M Clause)) -> MetaM (Core (M Clause))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss2 (MetaM (Core (M Clause)) -> MetaM (Core (M Clause)))
-> MetaM (Core (M Clause)) -> MetaM (Core (M Clause))
forall a b. (a -> b) -> a -> b
$ do {
       Core (M Body)
gs <- [LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
guards
     ; Core (M Clause)
clause <- Core [M Pat]
-> Core (M Body) -> Core [M Dec] -> MetaM (Core (M Clause))
repClause Core [M Pat]
ps1 Core (M Body)
gs Core [M Dec]
ds
     ; [GenSymBind] -> Core (M Clause) -> MetaM (Core (M Clause))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2) Core (M Clause)
clause }}}

repGuards ::  [LGRHS GhcRn (LHsExpr GhcRn)] ->  MetaM (Core (M TH.Body))
repGuards :: [LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [L SrcSpan
_ (GRHS XCGRHS GhcRn (LHsExpr GhcRn)
_ [] LHsExpr GhcRn
e)]
  = do {Core (M Exp)
a <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e; Core (M Exp) -> MetaM (Core (M Body))
repNormal Core (M Exp)
a }
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
other
  = do { [([GenSymBind], Core (M (Guard, Exp)))]
zs <- (LGRHS GhcRn (LHsExpr GhcRn)
 -> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp))))
-> [LGRHS GhcRn (LHsExpr GhcRn)]
-> ReaderT MetaWrappers DsM [([GenSymBind], Core (M (Guard, Exp)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LGRHS GhcRn (LHsExpr GhcRn)
-> ReaderT MetaWrappers DsM ([GenSymBind], Core (M (Guard, Exp)))
repLGRHS [LGRHS GhcRn (LHsExpr GhcRn)]
other
       ; let ([[GenSymBind]]
xs, [Core (M (Guard, Exp))]
ys) = [([GenSymBind], Core (M (Guard, Exp)))]
-> ([[GenSymBind]], [Core (M (Guard, Exp))])
forall a b. [(a, b)] -> ([a], [b])
unzip [([GenSymBind], Core (M (Guard, Exp)))]
zs
       ; Core (M Body)
gd <- Core [M (Guard, Exp)] -> MetaM (Core (M Body))
repGuarded ([Core (M (Guard, Exp))] -> Core [M (Guard, Exp)]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M (Guard, Exp))]
ys)
       ; [GenSymBind] -> Core (M Body) -> MetaM (Core (M Body))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms ([[GenSymBind]] -> [GenSymBind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenSymBind]]
xs) Core (M Body)
gd }

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

repFields :: HsRecordBinds GhcRn -> MetaM (Core [M TH.FieldExp])
repFields :: HsRecordBinds GhcRn -> MetaM (Core [M FieldExp])
repFields (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [LHsRecField GhcRn (LHsExpr GhcRn)]
flds })
  = Name
-> (LHsRecField GhcRn (LHsExpr GhcRn) -> MetaM (Core (M FieldExp)))
-> [LHsRecField GhcRn (LHsExpr GhcRn)]
-> MetaM (Core [M FieldExp])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
fieldExpTyConName LHsRecField GhcRn (LHsExpr GhcRn) -> MetaM (Core (M FieldExp))
rep_fld [LHsRecField GhcRn (LHsExpr GhcRn)]
flds
  where
    rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn)
            -> MetaM (Core (M TH.FieldExp))
    rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn) -> MetaM (Core (M FieldExp))
rep_fld (L SrcSpan
_ HsRecField GhcRn (LHsExpr GhcRn)
fld) = do { Core Name
fn <- Located Name -> MetaM (Core Name)
lookupLOcc (HsRecField GhcRn (LHsExpr GhcRn) -> Located (XCFieldOcc GhcRn)
forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel HsRecField GhcRn (LHsExpr GhcRn)
fld)
                           ; Core (M Exp)
e  <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE (HsRecField GhcRn (LHsExpr GhcRn) -> LHsExpr GhcRn
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg HsRecField GhcRn (LHsExpr GhcRn)
fld)
                           ; Core Name -> Core (M Exp) -> MetaM (Core (M FieldExp))
repFieldExp Core Name
fn Core (M Exp)
e }

repUpdFields :: [LHsRecUpdField GhcRn] -> MetaM (Core [M TH.FieldExp])
repUpdFields :: [LHsRecUpdField GhcRn] -> MetaM (Core [M FieldExp])
repUpdFields = Name
-> (LHsRecUpdField GhcRn -> MetaM (Core (M FieldExp)))
-> [LHsRecUpdField GhcRn]
-> MetaM (Core [M FieldExp])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
fieldExpTyConName LHsRecUpdField GhcRn -> MetaM (Core (M FieldExp))
rep_fld
  where
    rep_fld :: LHsRecUpdField GhcRn -> MetaM (Core (M TH.FieldExp))
    rep_fld :: LHsRecUpdField GhcRn -> MetaM (Core (M FieldExp))
rep_fld (L SrcSpan
l HsRecUpdField GhcRn
fld) = case GenLocated SrcSpan (AmbiguousFieldOcc GhcRn)
-> AmbiguousFieldOcc GhcRn
forall l e. GenLocated l e -> e
unLoc (HsRecUpdField GhcRn -> GenLocated SrcSpan (AmbiguousFieldOcc GhcRn)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl HsRecUpdField GhcRn
fld) of
      Unambiguous XUnambiguous GhcRn
sel_name Located RdrName
_ -> do { Core Name
fn <- Located Name -> MetaM (Core Name)
lookupLOcc (SrcSpan -> Name -> Located Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
XUnambiguous GhcRn
sel_name)
                                   ; Core (M Exp)
e  <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE (HsRecUpdField GhcRn -> LHsExpr GhcRn
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg HsRecUpdField GhcRn
fld)
                                   ; Core Name -> Core (M Exp) -> MetaM (Core (M FieldExp))
repFieldExp Core Name
fn Core (M Exp)
e }
      Ambiguous{}            -> String -> SDoc -> MetaM (Core (M FieldExp))
forall a. String -> SDoc -> MetaM a
notHandled String
"Ambiguous record updates" (HsRecUpdField GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsRecUpdField GhcRn
fld)



-----------------------------------------------------------------------------
-- 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 GhcRn] -> MetaM ([GenSymBind], [Core (M Stmt)])
repLSts [ExprLStmt GhcRn]
stmts = [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts ((ExprLStmt GhcRn -> Stmt GhcRn (LHsExpr GhcRn))
-> [ExprLStmt GhcRn] -> [Stmt GhcRn (LHsExpr GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map ExprLStmt GhcRn -> Stmt GhcRn (LHsExpr GhcRn)
forall l e. GenLocated l e -> e
unLoc [ExprLStmt GhcRn]
stmts)

repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> MetaM ([GenSymBind], [Core (M TH.Stmt)])
repSts :: [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts (BindStmt XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
_ LPat GhcRn
p LHsExpr GhcRn
e : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
   do { Core (M Exp)
e2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
      ; [GenSymBind]
ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms (LPat GhcRn -> [IdP GhcRn]
forall p. CollectPass p => LPat p -> [IdP p]
collectPatBinders LPat GhcRn
p)
      ; [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 (MetaM ([GenSymBind], [Core (M Stmt)])
 -> MetaM ([GenSymBind], [Core (M Stmt)]))
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a b. (a -> b) -> a -> b
$ do {
      ; Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p;
      ; ([GenSymBind]
ss2,[Core (M Stmt)]
zs) <- [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss
      ; Core (M Stmt)
z <- Core (M Pat) -> Core (M Exp) -> MetaM (Core (M Stmt))
repBindSt Core (M Pat)
p1 Core (M Exp)
e2
      ; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }}
repSts (LetStmt XLetStmt GhcRn GhcRn (LHsExpr GhcRn)
_ (L SrcSpan
_ HsLocalBinds GhcRn
bs) : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
   do { ([GenSymBind]
ss1,Core [M Dec]
ds) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
bs
      ; Core (M Stmt)
z <- Core [M Dec] -> MetaM (Core (M Stmt))
repLetSt Core [M Dec]
ds
      ; ([GenSymBind]
ss2,[Core (M Stmt)]
zs) <- [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 ([Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss)
      ; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }
repSts (BodyStmt XBodyStmt GhcRn GhcRn (LHsExpr GhcRn)
_ LHsExpr GhcRn
e SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_ : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
   do { Core (M Exp)
e2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
      ; Core (M Stmt)
z <- Core (M Exp) -> MetaM (Core (M Stmt))
repNoBindSt Core (M Exp)
e2
      ; ([GenSymBind]
ss2,[Core (M Stmt)]
zs) <- [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss
      ; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }
repSts (ParStmt XParStmt GhcRn GhcRn (LHsExpr GhcRn)
_ [ParStmtBlock GhcRn GhcRn]
stmt_blocks HsExpr GhcRn
_ SyntaxExpr GhcRn
_ : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
   do { ([[GenSymBind]]
ss_s, [Core [M Stmt]]
stmt_blocks1) <- (ParStmtBlock GhcRn GhcRn
 -> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt]))
-> [ParStmtBlock GhcRn GhcRn]
-> ReaderT MetaWrappers DsM ([[GenSymBind]], [Core [M Stmt]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM ParStmtBlock GhcRn GhcRn
-> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt])
rep_stmt_block [ParStmtBlock GhcRn GhcRn]
stmt_blocks
      ; let stmt_blocks2 :: Core [[M Stmt]]
stmt_blocks2 = [Core [M Stmt]] -> Core [[M Stmt]]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core [M Stmt]]
stmt_blocks1
            ss1 :: [GenSymBind]
ss1 = [[GenSymBind]] -> [GenSymBind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenSymBind]]
ss_s
      ; Core (M Stmt)
z <- Core [[M Stmt]] -> MetaM (Core (M Stmt))
repParSt Core [[M Stmt]]
stmt_blocks2
      ; ([GenSymBind]
ss2, [Core (M Stmt)]
zs) <- [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 ([Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss)
      ; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }
   where
     rep_stmt_block :: ParStmtBlock GhcRn GhcRn
                    -> MetaM ([GenSymBind], Core [(M TH.Stmt)])
     rep_stmt_block :: ParStmtBlock GhcRn GhcRn
-> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt])
rep_stmt_block (ParStmtBlock XParStmtBlock GhcRn GhcRn
_ [ExprLStmt GhcRn]
stmts [IdP GhcRn]
_ SyntaxExpr GhcRn
_) =
       do { ([GenSymBind]
ss1, [Core (M Stmt)]
zs) <- [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts ((ExprLStmt GhcRn -> Stmt GhcRn (LHsExpr GhcRn))
-> [ExprLStmt GhcRn] -> [Stmt GhcRn (LHsExpr GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map ExprLStmt GhcRn -> Stmt GhcRn (LHsExpr GhcRn)
forall l e. GenLocated l e -> e
unLoc [ExprLStmt GhcRn]
stmts)
          ; Core [M Stmt]
zs1 <- Name -> [Core (M Stmt)] -> MetaM (Core [M Stmt])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
stmtTyConName [Core (M Stmt)]
zs
          ; ([GenSymBind], Core [M Stmt])
-> ReaderT MetaWrappers DsM ([GenSymBind], Core [M Stmt])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1, Core [M Stmt]
zs1) }
repSts [LastStmt XLastStmt GhcRn GhcRn (LHsExpr GhcRn)
_ LHsExpr GhcRn
e Maybe Bool
_ SyntaxExpr GhcRn
_]
  = do { Core (M Exp)
e2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
       ; Core (M Stmt)
z <- Core (M Exp) -> MetaM (Core (M Stmt))
repNoBindSt Core (M Exp)
e2
       ; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Core (M Stmt)
z]) }
repSts (stmt :: Stmt GhcRn (LHsExpr GhcRn)
stmt@RecStmt{} : [Stmt GhcRn (LHsExpr GhcRn)]
ss)
  = do { let binders :: [IdP GhcRn]
binders = [ExprLStmt GhcRn] -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders (Stmt GhcRn (LHsExpr GhcRn) -> [ExprLStmt GhcRn]
forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_stmts Stmt GhcRn (LHsExpr GhcRn)
stmt)
       ; [GenSymBind]
ss1 <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
[IdP GhcRn]
binders
       -- Bring all of binders in the recursive group into scope for the
       -- whole group.
       ; ([GenSymBind]
ss1_other,[Core (M Stmt)]
rss) <- [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 (MetaM ([GenSymBind], [Core (M Stmt)])
 -> MetaM ([GenSymBind], [Core (M Stmt)]))
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a b. (a -> b) -> a -> b
$ [Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts ((ExprLStmt GhcRn -> Stmt GhcRn (LHsExpr GhcRn))
-> [ExprLStmt GhcRn] -> [Stmt GhcRn (LHsExpr GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map ExprLStmt GhcRn -> Stmt GhcRn (LHsExpr GhcRn)
forall l e. GenLocated l e -> e
unLoc (Stmt GhcRn (LHsExpr GhcRn) -> [ExprLStmt GhcRn]
forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_stmts Stmt GhcRn (LHsExpr GhcRn)
stmt))
       ; MASSERT(sort ss1 == sort ss1_other)
       ; Core (M Stmt)
z <- Core [M Stmt] -> MetaM (Core (M Stmt))
repRecSt ([Core (M Stmt)] -> Core [M Stmt]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Stmt)]
rss)
       ; ([GenSymBind]
ss2,[Core (M Stmt)]
zs) <- [GenSymBind]
-> MetaM ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss1 ([Stmt GhcRn (LHsExpr GhcRn)]
-> MetaM ([GenSymBind], [Core (M Stmt)])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss)
       ; ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core (M Stmt)
z Core (M Stmt) -> [Core (M Stmt)] -> [Core (M Stmt)]
forall a. a -> [a] -> [a]
: [Core (M Stmt)]
zs) }
repSts []    = ([GenSymBind], [Core (M Stmt)])
-> MetaM ([GenSymBind], [Core (M Stmt)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
other = String -> SDoc -> MetaM ([GenSymBind], [Core (M Stmt)])
forall a. String -> SDoc -> MetaM a
notHandled String
"Exotic statement" ([Stmt GhcRn (LHsExpr GhcRn)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Stmt GhcRn (LHsExpr GhcRn)]
other)


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

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

repBinds (HsIPBinds XHsIPBinds GhcRn GhcRn
_ (IPBinds XIPBinds GhcRn
_ [LIPBind GhcRn]
decs))
 = do   { [(SrcSpan, Core (M Dec))]
ips <- (LIPBind GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [LIPBind GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LIPBind GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_implicit_param_bind [LIPBind GhcRn]
decs
        ; Core [M Dec]
core_list <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName
                                ([(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc [(SrcSpan, Core (M Dec))]
ips))
        ; ([GenSymBind], Core [M Dec]) -> MetaM ([GenSymBind], Core [M Dec])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Core [M Dec]
core_list)
        }

repBinds (HsValBinds XHsValBinds GhcRn GhcRn
_ HsValBinds GhcRn
decs)
 = do   { let { bndrs :: [Name]
bndrs = HsValBinds GhcRn -> [Name]
hsScopedTvBinders HsValBinds GhcRn
decs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ HsValBinds GhcRn -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsValBinders HsValBinds GhcRn
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]
        ; [GenSymBind]
ss        <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
bndrs
        ; [(SrcSpan, Core (M Dec))]
prs       <- [GenSymBind]
-> MetaM [(SrcSpan, Core (M Dec))]
-> MetaM [(SrcSpan, Core (M Dec))]
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (HsValBinds GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_val_binds HsValBinds GhcRn
decs)
        ; Core [M Dec]
core_list <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName
                                ([(SrcSpan, Core (M Dec))] -> [Core (M Dec)]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc [(SrcSpan, Core (M Dec))]
prs))
        ; ([GenSymBind], Core [M Dec]) -> MetaM ([GenSymBind], Core [M Dec])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss, Core [M Dec]
core_list) }

rep_implicit_param_bind :: LIPBind GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
rep_implicit_param_bind :: LIPBind GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_implicit_param_bind (L SrcSpan
loc (IPBind XCIPBind GhcRn
_ Either (Located HsIPName) (IdP GhcRn)
ename (L SrcSpan
_ HsExpr GhcRn
rhs)))
 = do { Core String
name <- case Either (Located HsIPName) (IdP GhcRn)
ename of
                    Left (L SrcSpan
_ HsIPName
n) -> HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name HsIPName
n
                    Right IdP GhcRn
_ ->
                        String -> ReaderT MetaWrappers DsM (Core String)
forall a. String -> a
panic String
"rep_implicit_param_bind: post typechecking"
      ; Core (M Exp)
rhs' <- HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
rhs
      ; Core (M Dec)
ipb <- Core String -> Core (M Exp) -> MetaM (Core (M Dec))
repImplicitParamBind Core String
name Core (M Exp)
rhs'
      ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
ipb) }

rep_implicit_param_name :: HsIPName -> MetaM (Core String)
rep_implicit_param_name :: HsIPName -> ReaderT MetaWrappers DsM (Core String)
rep_implicit_param_name (HsIPName CLabelString
name) = String -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit (CLabelString -> String
unpackFS CLabelString
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 GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_val_binds (XValBindsLR (NValBinds [(RecFlag, LHsBindsLR GhcRn GhcRn)]
binds [LSig GhcRn]
sigs))
 = do { [(SrcSpan, Core (M Dec))]
core1 <- LHsBindsLR GhcRn GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_binds ([LHsBindsLR GhcRn GhcRn] -> LHsBindsLR GhcRn GhcRn
forall a. [Bag a] -> Bag a
unionManyBags (((RecFlag, LHsBindsLR GhcRn GhcRn) -> LHsBindsLR GhcRn GhcRn)
-> [(RecFlag, LHsBindsLR GhcRn GhcRn)] -> [LHsBindsLR GhcRn GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag, LHsBindsLR GhcRn GhcRn) -> LHsBindsLR GhcRn GhcRn
forall a b. (a, b) -> b
snd [(RecFlag, LHsBindsLR GhcRn GhcRn)]
binds))
      ; [(SrcSpan, Core (M Dec))]
core2 <- [LSig GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
rep_sigs [LSig GhcRn]
sigs
      ; [(SrcSpan, Core (M Dec))] -> MetaM [(SrcSpan, Core (M Dec))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SrcSpan, Core (M Dec))]
core1 [(SrcSpan, Core (M Dec))]
-> [(SrcSpan, Core (M Dec))] -> [(SrcSpan, Core (M Dec))]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core (M Dec))]
core2) }
rep_val_binds (ValBinds XValBinds GhcRn GhcRn
_ LHsBindsLR GhcRn GhcRn
_ [LSig GhcRn]
_)
 = String -> MetaM [(SrcSpan, Core (M Dec))]
forall a. String -> a
panic String
"rep_val_binds: ValBinds"

rep_binds :: LHsBinds GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_binds :: LHsBindsLR GhcRn GhcRn -> MetaM [(SrcSpan, Core (M Dec))]
rep_binds = (LHsBind GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec)))
-> [LHsBind GhcRn] -> MetaM [(SrcSpan, Core (M Dec))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsBind GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_bind ([LHsBind GhcRn] -> MetaM [(SrcSpan, Core (M Dec))])
-> (LHsBindsLR GhcRn GhcRn -> [LHsBind GhcRn])
-> LHsBindsLR GhcRn GhcRn
-> MetaM [(SrcSpan, Core (M Dec))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBindsLR GhcRn GhcRn -> [LHsBind GhcRn]
forall a. Bag a -> [a]
bagToList

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 GhcRn -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
rep_bind (L SrcSpan
loc (FunBind
                 { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = Located (IdP GhcRn)
fn,
                   fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts
                           = (L SrcSpan
_ [L SrcSpan
_ (Match
                                   { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = []
                                   , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs GhcRn (LHsExpr GhcRn)
_ [LGRHS GhcRn (LHsExpr GhcRn)]
guards (L SrcSpan
_ HsLocalBinds GhcRn
wheres) }
                                      )]) } }))
 = do { ([GenSymBind]
ss,Core [M Dec]
wherecore) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
wheres
        ; Core (M Body)
guardcore <- [GenSymBind] -> MetaM (Core (M Body)) -> MetaM (Core (M Body))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss ([LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
guards)
        ; Core Name
fn'  <- Located Name -> MetaM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
fn
        ; Core (M Pat)
p    <- Core Name -> MetaM (Core (M Pat))
repPvar Core Name
fn'
        ; Core (M Dec)
ans  <- Core (M Pat)
-> Core (M Body) -> Core [M Dec] -> MetaM (Core (M Dec))
repVal Core (M Pat)
p Core (M Body)
guardcore Core [M Dec]
wherecore
        ; Core (M Dec)
ans' <- [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
ans
        ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
ans') }

rep_bind (L SrcSpan
loc (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = Located (IdP GhcRn)
fn
                         , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = L SrcSpan
_ [LMatch GhcRn (LHsExpr GhcRn)]
ms } }))
 =   do { [Core (M Clause)]
ms1 <- (LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M Clause)))
-> [LMatch GhcRn (LHsExpr GhcRn)]
-> ReaderT MetaWrappers DsM [Core (M Clause)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M Clause))
repClauseTup [LMatch GhcRn (LHsExpr GhcRn)]
ms
        ; Core Name
fn' <- Located Name -> MetaM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
fn
        ; Core (M Dec)
ans <- Core Name -> Core [M Clause] -> MetaM (Core (M Dec))
repFun Core Name
fn' ([Core (M Clause)] -> Core [M Clause]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Clause)]
ms1)
        ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
ans) }

rep_bind (L SrcSpan
loc (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcRn
pat
                         , pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs = GRHSs XCGRHSs GhcRn (LHsExpr GhcRn)
_ [LGRHS GhcRn (LHsExpr GhcRn)]
guards (L SrcSpan
_ HsLocalBinds GhcRn
wheres) }))
 =   do { Core (M Pat)
patcore <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
pat
        ; ([GenSymBind]
ss,Core [M Dec]
wherecore) <- HsLocalBinds GhcRn -> MetaM ([GenSymBind], Core [M Dec])
repBinds HsLocalBinds GhcRn
wheres
        ; Core (M Body)
guardcore <- [GenSymBind] -> MetaM (Core (M Body)) -> MetaM (Core (M Body))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss ([LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M Body))
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
guards)
        ; Core (M Dec)
ans  <- Core (M Pat)
-> Core (M Body) -> Core [M Dec] -> MetaM (Core (M Dec))
repVal Core (M Pat)
patcore Core (M Body)
guardcore Core [M Dec]
wherecore
        ; Core (M Dec)
ans' <- [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
ans
        ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
ans') }

rep_bind (L SrcSpan
_ (VarBind { var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP GhcRn
v, var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs = LHsExpr GhcRn
e}))
 =   do { Core Name
v' <- Name -> MetaM (Core Name)
lookupBinder Name
IdP GhcRn
v
        ; Core (M Exp)
e2 <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
        ; Core (M Body)
x <- Core (M Exp) -> MetaM (Core (M Body))
repNormal Core (M Exp)
e2
        ; Core (M Pat)
patcore <- Core Name -> MetaM (Core (M Pat))
repPvar Core Name
v'
        ; Core [M Dec]
empty_decls <- Name -> [Core (M Dec)] -> MetaM (Core [M Dec])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
decTyConName []
        ; Core (M Dec)
ans <- Core (M Pat)
-> Core (M Body) -> Core [M Dec] -> MetaM (Core (M Dec))
repVal Core (M Pat)
patcore Core (M Body)
x Core [M Dec]
empty_decls
        ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcLoc -> SrcSpan
srcLocSpan (Name -> SrcLoc
forall a. NamedThing a => a -> SrcLoc
getSrcLoc Name
IdP GhcRn
v), Core (M Dec)
ans) }

rep_bind (L SrcSpan
_ (AbsBinds {}))  = String -> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall a. String -> a
panic String
"rep_bind: AbsBinds"
rep_bind (L SrcSpan
loc (PatSynBind XPatSynBind GhcRn GhcRn
_ (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
psb_id   = Located (IdP GhcRn)
syn
                                   , psb_args :: forall idL idR.
PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
psb_args = HsPatSynDetails (Located (IdP GhcRn))
args
                                   , psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def  = LPat GhcRn
pat
                                   , psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir  = HsPatSynDir GhcRn
dir })))
  = do { Core Name
syn'      <- Located Name -> MetaM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
syn
       ; Core (M PatSynDir)
dir'      <- HsPatSynDir GhcRn -> MetaM (Core (M PatSynDir))
repPatSynDir HsPatSynDir GhcRn
dir
       ; [GenSymBind]
ss        <- HsPatSynDetails (Located Name) -> MetaM [GenSymBind]
mkGenArgSyms HsPatSynDetails (Located Name)
HsPatSynDetails (Located (IdP GhcRn))
args
       ; Core (M Dec)
patSynD'  <- [GenSymBind] -> MetaM (Core (M Dec)) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (
         do { Core (M PatSynArgs)
args'  <- HsPatSynDetails (Located Name) -> MetaM (Core (M PatSynArgs))
repPatSynArgs HsPatSynDetails (Located Name)
HsPatSynDetails (Located (IdP GhcRn))
args
            ; Core (M Pat)
pat'   <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
pat
            ; Core Name
-> Core (M PatSynArgs)
-> Core (M PatSynDir)
-> Core (M Pat)
-> MetaM (Core (M Dec))
repPatSynD Core Name
syn' Core (M PatSynArgs)
args' Core (M PatSynDir)
dir' Core (M Pat)
pat' })
       ; Core (M Dec)
patSynD'' <- HsPatSynDetails (Located Name)
-> [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
wrapGenArgSyms HsPatSynDetails (Located Name)
HsPatSynDetails (Located (IdP GhcRn))
args [GenSymBind]
ss Core (M Dec)
patSynD'
       ; (SrcSpan, Core (M Dec))
-> ReaderT MetaWrappers DsM (SrcSpan, Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core (M Dec)
patSynD'') }
  where
    mkGenArgSyms :: HsPatSynDetails (Located Name) -> 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 (Located Name) -> MetaM [GenSymBind]
mkGenArgSyms (PrefixCon [Located Name]
args)     = [Name] -> MetaM [GenSymBind]
mkGenSyms ((Located Name -> Name) -> [Located Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Located Name -> Name
forall l e. GenLocated l e -> e
unLoc [Located Name]
args)
    mkGenArgSyms (InfixCon Located Name
arg1 Located Name
arg2) = [Name] -> MetaM [GenSymBind]
mkGenSyms [Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
arg1, Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
arg2]
    mkGenArgSyms (RecCon [RecordPatSynField (Located Name)]
fields)
      = do { let pats :: [Name]
pats = (RecordPatSynField (Located Name) -> Name)
-> [RecordPatSynField (Located Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc (Located Name -> Name)
-> (RecordPatSynField (Located Name) -> Located Name)
-> RecordPatSynField (Located Name)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located Name) -> Located Name
forall a. RecordPatSynField a -> a
recordPatSynPatVar) [RecordPatSynField (Located Name)]
fields
                 sels :: [Name]
sels = (RecordPatSynField (Located Name) -> Name)
-> [RecordPatSynField (Located Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc (Located Name -> Name)
-> (RecordPatSynField (Located Name) -> Located Name)
-> RecordPatSynField (Located Name)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located Name) -> Located Name
forall a. RecordPatSynField a -> a
recordPatSynSelectorId) [RecordPatSynField (Located Name)]
fields
           ; [GenSymBind]
ss <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
sels
           ; [GenSymBind] -> MetaM [GenSymBind]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind] -> MetaM [GenSymBind])
-> [GenSymBind] -> MetaM [GenSymBind]
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> [GenSymBind] -> [GenSymBind]
forall {a} {a} {b}. Eq a => [(a, a)] -> [(a, b)] -> [(a, b)]
replaceNames ([Name] -> [Name] -> [(Name, Name)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
sels [Name]
pats) [GenSymBind]
ss }

    replaceNames :: [(a, a)] -> [(a, b)] -> [(a, b)]
replaceNames [(a, a)]
selsPats [(a, b)]
genSyms
      = [ (a
pat, b
id) | (a
sel, b
id) <- [(a, b)]
genSyms, (a
sel', a
pat) <- [(a, a)]
selsPats
                    , a
sel a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
sel' ]

    wrapGenArgSyms :: HsPatSynDetails (Located Name)
                   -> [GenSymBind] -> Core (M TH.Dec) -> MetaM (Core (M TH.Dec))
    wrapGenArgSyms :: HsPatSynDetails (Located Name)
-> [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
wrapGenArgSyms (RecCon [RecordPatSynField (Located Name)]
_) [GenSymBind]
_  Core (M Dec)
dec = Core (M Dec) -> MetaM (Core (M Dec))
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Dec)
dec
    wrapGenArgSyms HsPatSynDetails (Located Name)
_          [GenSymBind]
ss Core (M Dec)
dec = [GenSymBind] -> Core (M Dec) -> MetaM (Core (M Dec))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Dec)
dec

repPatSynD :: Core TH.Name
           -> Core (M TH.PatSynArgs)
           -> Core (M TH.PatSynDir)
           -> Core (M TH.Pat)
           -> MetaM (Core (M TH.Dec))
repPatSynD :: Core Name
-> Core (M PatSynArgs)
-> Core (M PatSynDir)
-> Core (M Pat)
-> MetaM (Core (M Dec))
repPatSynD (MkC CoreExpr
syn) (MkC CoreExpr
args) (MkC CoreExpr
dir) (MkC CoreExpr
pat)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
patSynDName [CoreExpr
syn, CoreExpr
args, CoreExpr
dir, CoreExpr
pat]

repPatSynArgs :: HsPatSynDetails (Located Name) -> MetaM (Core (M TH.PatSynArgs))
repPatSynArgs :: HsPatSynDetails (Located Name) -> MetaM (Core (M PatSynArgs))
repPatSynArgs (PrefixCon [Located Name]
args)
  = do { Core [Name]
args' <- Name
-> (Located Name -> MetaM (Core Name))
-> [Located Name]
-> MetaM (Core [Name])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
nameTyConName Located Name -> MetaM (Core Name)
lookupLOcc [Located Name]
args
       ; Core [Name] -> MetaM (Core (M PatSynArgs))
repPrefixPatSynArgs Core [Name]
args' }
repPatSynArgs (InfixCon Located Name
arg1 Located Name
arg2)
  = do { Core Name
arg1' <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
arg1
       ; Core Name
arg2' <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
arg2
       ; Core Name -> Core Name -> MetaM (Core (M PatSynArgs))
repInfixPatSynArgs Core Name
arg1' Core Name
arg2' }
repPatSynArgs (RecCon [RecordPatSynField (Located Name)]
fields)
  = do { Core [Name]
sels' <- Name
-> (Located Name -> MetaM (Core Name))
-> [Located Name]
-> MetaM (Core [Name])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repList Name
nameTyConName Located Name -> MetaM (Core Name)
lookupLOcc [Located Name]
sels
       ; Core [Name] -> MetaM (Core (M PatSynArgs))
repRecordPatSynArgs Core [Name]
sels' }
  where sels :: [Located Name]
sels = (RecordPatSynField (Located Name) -> Located Name)
-> [RecordPatSynField (Located Name)] -> [Located Name]
forall a b. (a -> b) -> [a] -> [b]
map RecordPatSynField (Located Name) -> Located Name
forall a. RecordPatSynField a -> a
recordPatSynSelectorId [RecordPatSynField (Located Name)]
fields

repPrefixPatSynArgs :: Core [TH.Name] -> MetaM (Core (M TH.PatSynArgs))
repPrefixPatSynArgs :: Core [Name] -> MetaM (Core (M PatSynArgs))
repPrefixPatSynArgs (MkC CoreExpr
nms) = Name -> [CoreExpr] -> MetaM (Core (M PatSynArgs))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
prefixPatSynName [CoreExpr
nms]

repInfixPatSynArgs :: Core TH.Name -> Core TH.Name -> MetaM (Core (M TH.PatSynArgs))
repInfixPatSynArgs :: Core Name -> Core Name -> MetaM (Core (M PatSynArgs))
repInfixPatSynArgs (MkC CoreExpr
nm1) (MkC CoreExpr
nm2) = Name -> [CoreExpr] -> MetaM (Core (M PatSynArgs))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixPatSynName [CoreExpr
nm1, CoreExpr
nm2]

repRecordPatSynArgs :: Core [TH.Name]
                    -> MetaM (Core (M TH.PatSynArgs))
repRecordPatSynArgs :: Core [Name] -> MetaM (Core (M PatSynArgs))
repRecordPatSynArgs (MkC CoreExpr
sels) = Name -> [CoreExpr] -> MetaM (Core (M PatSynArgs))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recordPatSynName [CoreExpr
sels]

repPatSynDir :: HsPatSynDir GhcRn -> MetaM (Core (M TH.PatSynDir))
repPatSynDir :: HsPatSynDir GhcRn -> MetaM (Core (M PatSynDir))
repPatSynDir HsPatSynDir GhcRn
Unidirectional        = Name -> [CoreExpr] -> MetaM (Core (M PatSynDir))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unidirPatSynName []
repPatSynDir HsPatSynDir GhcRn
ImplicitBidirectional = Name -> [CoreExpr] -> MetaM (Core (M PatSynDir))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
implBidirPatSynName []
repPatSynDir (ExplicitBidirectional (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = (L SrcSpan
_ [LMatch GhcRn (LHsExpr GhcRn)]
clauses) }))
  = do { [Core (M Clause)]
clauses' <- (LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M Clause)))
-> [LMatch GhcRn (LHsExpr GhcRn)]
-> ReaderT MetaWrappers DsM [Core (M Clause)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M Clause))
repClauseTup [LMatch GhcRn (LHsExpr GhcRn)]
clauses
       ; Core [M Clause] -> MetaM (Core (M PatSynDir))
repExplBidirPatSynDir ([Core (M Clause)] -> Core [M Clause]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (M Clause)]
clauses') }

repExplBidirPatSynDir :: Core [(M TH.Clause)] -> MetaM (Core (M TH.PatSynDir))
repExplBidirPatSynDir :: Core [M Clause] -> MetaM (Core (M PatSynDir))
repExplBidirPatSynDir (MkC CoreExpr
cls) = Name -> [CoreExpr] -> MetaM (Core (M PatSynDir))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
explBidirPatSynName [CoreExpr
cls]


-----------------------------------------------------------------------------
-- 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 GhcRn (LHsExpr GhcRn) -> MetaM (Core (M Exp))
repLambda (L SrcSpan
_ (Match { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcRn]
ps
                      , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs XCGRHSs GhcRn (LHsExpr GhcRn)
_ [L SrcSpan
_ (GRHS XCGRHS GhcRn (LHsExpr GhcRn)
_ [] LHsExpr GhcRn
e)]
                                              (L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds GhcRn GhcRn
_)) } ))
 = do { let bndrs :: [IdP GhcRn]
bndrs = [LPat GhcRn] -> [IdP GhcRn]
forall p. CollectPass p => [LPat p] -> [IdP p]
collectPatsBinders [LPat GhcRn]
ps ;
      ; [GenSymBind]
ss  <- [Name] -> MetaM [GenSymBind]
mkGenSyms [Name]
[IdP GhcRn]
bndrs
      ; Core (M Exp)
lam <- [GenSymBind] -> MetaM (Core (M Exp)) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> MetaM a -> MetaM a
addBinds [GenSymBind]
ss (
                do { Core [M Pat]
xs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps; Core (M Exp)
body <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e; Core [M Pat] -> Core (M Exp) -> MetaM (Core (M Exp))
repLam Core [M Pat]
xs Core (M Exp)
body })
      ; [GenSymBind] -> Core (M Exp) -> MetaM (Core (M Exp))
forall a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
ss Core (M Exp)
lam }

repLambda (L SrcSpan
_ Match GhcRn (LHsExpr GhcRn)
m) = String -> SDoc -> MetaM (Core (M Exp))
forall a. String -> SDoc -> MetaM a
notHandled String
"Guarded lambdas" (Match GhcRn (LHsExpr GhcRn) -> SDoc
forall (idR :: Pass) body.
(OutputableBndrId idR, Outputable body) =>
Match (GhcPass idR) body -> SDoc
pprMatch Match GhcRn (LHsExpr GhcRn)
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 GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps = Name
-> (Located (Pat GhcRn) -> MetaM (Core (M Pat)))
-> [Located (Pat GhcRn)]
-> MetaM (Core [M Pat])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
patTyConName Located (Pat GhcRn) -> MetaM (Core (M Pat))
LPat GhcRn -> MetaM (Core (M Pat))
repLP [Located (Pat GhcRn)]
[LPat GhcRn]
ps

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

repP :: Pat GhcRn -> MetaM (Core (M TH.Pat))
repP :: Pat GhcRn -> MetaM (Core (M Pat))
repP (WildPat XWildPat GhcRn
_)        = MetaM (Core (M Pat))
repPwild
repP (LitPat XLitPat GhcRn
_ HsLit GhcRn
l)       = do { Core Lit
l2 <- HsLit GhcRn -> MetaM (Core Lit)
repLiteral HsLit GhcRn
l; Core Lit -> MetaM (Core (M Pat))
repPlit Core Lit
l2 }
repP (VarPat XVarPat GhcRn
_ Located (IdP GhcRn)
x)       = do { Core Name
x' <- Name -> MetaM (Core Name)
lookupBinder (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
Located (IdP GhcRn)
x); Core Name -> MetaM (Core (M Pat))
repPvar Core Name
x' }
repP (LazyPat XLazyPat GhcRn
_ LPat GhcRn
p)      = do { Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p; Core (M Pat) -> MetaM (Core (M Pat))
repPtilde Core (M Pat)
p1 }
repP (BangPat XBangPat GhcRn
_ LPat GhcRn
p)      = do { Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p; Core (M Pat) -> MetaM (Core (M Pat))
repPbang Core (M Pat)
p1 }
repP (AsPat XAsPat GhcRn
_ Located (IdP GhcRn)
x LPat GhcRn
p)      = do { Core Name
x' <- Located Name -> MetaM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
x; Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
                             ; Core Name -> Core (M Pat) -> MetaM (Core (M Pat))
repPaspat Core Name
x' Core (M Pat)
p1 }
repP (ParPat XParPat GhcRn
_ LPat GhcRn
p)       = LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
repP (ListPat Maybe SyntaxExprRn
XListPat GhcRn
Nothing [LPat GhcRn]
ps)  = do { Core [M Pat]
qs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps; Core [M Pat] -> MetaM (Core (M Pat))
repPlist Core [M Pat]
qs }
repP (ListPat (Just (SyntaxExprRn HsExpr GhcRn
e)) [LPat GhcRn]
ps) = do { Core (M Pat)
p <- Pat GhcRn -> MetaM (Core (M Pat))
repP (XListPat GhcRn -> [LPat GhcRn] -> Pat GhcRn
forall p. XListPat p -> [LPat p] -> Pat p
ListPat XListPat GhcRn
forall a. Maybe a
Nothing [LPat GhcRn]
ps)
                                               ; Core (M Exp)
e' <- HsExpr GhcRn -> MetaM (Core (M Exp))
repE HsExpr GhcRn
e
                                               ; Core (M Exp) -> Core (M Pat) -> MetaM (Core (M Pat))
repPview Core (M Exp)
e' Core (M Pat)
p}
repP (ListPat XListPat GhcRn
_ [LPat GhcRn]
ps) = String -> SDoc -> MetaM (Core (M Pat))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repP missing SyntaxExprRn" ([Located (Pat GhcRn)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Located (Pat GhcRn)]
[LPat GhcRn]
ps)
repP (TuplePat XTuplePat GhcRn
_ [LPat GhcRn]
ps Boxity
boxed)
  | Boxity -> Bool
isBoxed Boxity
boxed       = do { Core [M Pat]
qs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps; Core [M Pat] -> MetaM (Core (M Pat))
repPtup Core [M Pat]
qs }
  | Bool
otherwise           = do { Core [M Pat]
qs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps; Core [M Pat] -> MetaM (Core (M Pat))
repPunboxedTup Core [M Pat]
qs }
repP (SumPat XSumPat GhcRn
_ LPat GhcRn
p Int
alt Int
arity) = do { Core (M Pat)
p1 <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
                                 ; Core (M Pat) -> Int -> Int -> MetaM (Core (M Pat))
repPunboxedSum Core (M Pat)
p1 Int
alt Int
arity }
repP (ConPat NoExtField
XConPat GhcRn
NoExtField Located (ConLikeP GhcRn)
dc HsConPatDetails GhcRn
details)
 = do { Core Name
con_str <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
Located (ConLikeP GhcRn)
dc
      ; case HsConPatDetails GhcRn
details of
         PrefixCon [LPat GhcRn]
ps -> do { Core [M Pat]
qs <- [LPat GhcRn] -> MetaM (Core [M Pat])
repLPs [LPat GhcRn]
ps; Core Name -> Core [M Pat] -> MetaM (Core (M Pat))
repPcon Core Name
con_str Core [M Pat]
qs }
         RecCon HsRecFields GhcRn (LPat GhcRn)
rec   -> do { Core [M (Name, Pat)]
fps <- Name
-> (LHsRecField GhcRn (Located (Pat GhcRn))
    -> MetaM (Core (M (Name, Pat))))
-> [LHsRecField GhcRn (Located (Pat GhcRn))]
-> MetaM (Core [M (Name, Pat)])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
fieldPatTyConName LHsRecField GhcRn (Located (Pat GhcRn))
-> MetaM (Core (M (Name, Pat)))
LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (Name, Pat)))
rep_fld (HsRecFields GhcRn (Located (Pat GhcRn))
-> [LHsRecField GhcRn (Located (Pat GhcRn))]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields GhcRn (Located (Pat GhcRn))
HsRecFields GhcRn (LPat GhcRn)
rec)
                            ; Core Name -> Core [M (Name, Pat)] -> MetaM (Core (M Pat))
repPrec Core Name
con_str Core [M (Name, Pat)]
fps }
         InfixCon LPat GhcRn
p1 LPat GhcRn
p2 -> do { Core (M Pat)
p1' <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p1;
                                Core (M Pat)
p2' <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p2;
                                Core (M Pat) -> Core Name -> Core (M Pat) -> MetaM (Core (M Pat))
repPinfix Core (M Pat)
p1' Core Name
con_str Core (M Pat)
p2' }
   }
 where
   rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (TH.Name, TH.Pat)))
   rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (Name, Pat)))
rep_fld (L SrcSpan
_ HsRecField GhcRn (LPat GhcRn)
fld) = do { MkC CoreExpr
v <- Located Name -> MetaM (Core Name)
lookupLOcc (HsRecField GhcRn (Located (Pat GhcRn))
-> Located (XCFieldOcc GhcRn)
forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel HsRecField GhcRn (Located (Pat GhcRn))
HsRecField GhcRn (LPat GhcRn)
fld)
                          ; MkC CoreExpr
p <- LPat GhcRn -> MetaM (Core (M Pat))
repLP (HsRecField GhcRn (Located (Pat GhcRn)) -> Located (Pat GhcRn)
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg HsRecField GhcRn (Located (Pat GhcRn))
HsRecField GhcRn (LPat GhcRn)
fld)
                          ; Name -> [CoreExpr] -> MetaM (Core (M (Name, Pat)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fieldPatName [CoreExpr
v,CoreExpr
p] }

repP (NPat XNPat GhcRn
_ (L SrcSpan
_ HsOverLit GhcRn
l) Maybe (SyntaxExpr GhcRn)
Nothing SyntaxExpr GhcRn
_) = do { Core Lit
a <- HsOverLit GhcRn -> MetaM (Core Lit)
repOverloadedLiteral HsOverLit GhcRn
l
                                     ; Core Lit -> MetaM (Core (M Pat))
repPlit Core Lit
a }
repP (ViewPat XViewPat GhcRn
_ LHsExpr GhcRn
e LPat GhcRn
p) = do { Core (M Exp)
e' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e; Core (M Pat)
p' <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p; Core (M Exp) -> Core (M Pat) -> MetaM (Core (M Pat))
repPview Core (M Exp)
e' Core (M Pat)
p' }
repP p :: Pat GhcRn
p@(NPat XNPat GhcRn
_ GenLocated SrcSpan (HsOverLit GhcRn)
_ (Just SyntaxExpr GhcRn
_) SyntaxExpr GhcRn
_) = String -> SDoc -> MetaM (Core (M Pat))
forall a. String -> SDoc -> MetaM a
notHandled String
"Negative overloaded patterns" (Pat GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcRn
p)
repP (SigPat XSigPat GhcRn
_ LPat GhcRn
p HsPatSigType (NoGhcTc GhcRn)
t) = do { Core (M Pat)
p' <- LPat GhcRn -> MetaM (Core (M Pat))
repLP LPat GhcRn
p
                         ; Core (M Type)
t' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy (HsPatSigType GhcRn -> LHsType GhcRn
forall pass. HsPatSigType pass -> LHsType pass
hsPatSigType HsPatSigType GhcRn
HsPatSigType (NoGhcTc GhcRn)
t)
                         ; Core (M Pat) -> Core (M Type) -> MetaM (Core (M Pat))
repPsig Core (M Pat)
p' Core (M Type)
t' }
repP (SplicePat XSplicePat GhcRn
_ HsSplice GhcRn
splice) = HsSplice GhcRn -> MetaM (Core (M Pat))
forall a. HsSplice GhcRn -> MetaM (Core a)
repSplice HsSplice GhcRn
splice
repP Pat GhcRn
other = String -> SDoc -> MetaM (Core (M Pat))
forall a. String -> SDoc -> MetaM a
notHandled String
"Exotic pattern" (Pat GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcRn
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 { Type
var_ty <- Name -> MetaM Type
lookupType Name
nameTyConName
                  ; [GenSymBind] -> MetaM [GenSymBind]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name
nm, HasDebugCallStack => Name -> Type -> Type -> Id
Name -> Type -> Type -> Id
mkLocalId (Name -> Name
localiseName Name
nm) Type
Many Type
var_ty) | Name
nm <- [Name]
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
--
lookupLBinder :: Located Name -> MetaM (Core TH.Name)
lookupLBinder :: Located Name -> MetaM (Core Name)
lookupLBinder Located Name
n = Name -> MetaM (Core Name)
lookupBinder (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located 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 :: Located Name -> MetaM (Core TH.Name)
-- Lookup an occurrence; it can't be a splice.
-- Use the in-scope bindings if they exist
lookupLOcc :: Located Name -> MetaM (Core Name)
lookupLOcc Located Name
n = Name -> MetaM (Core Name)
lookupOcc (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
n)

lookupOcc :: Name -> MetaM (Core TH.Name)
lookupOcc :: Name -> MetaM (Core Name)
lookupOcc = DsM (Core Name) -> MetaM (Core Name)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM (Core Name) -> MetaM (Core Name))
-> (Name -> DsM (Core Name)) -> Name -> MetaM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> DsM (Core Name)
lookupOccDsM

lookupOccDsM :: Name -> DsM (Core TH.Name)
lookupOccDsM :: Name -> DsM (Core Name)
lookupOccDsM Name
n
  = do {  Maybe DsMetaVal
mb_val <- Name -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe DsMetaVal)
dsLookupMetaEnv Name
n ;
          case Maybe DsMetaVal
mb_val of
                Maybe DsMetaVal
Nothing           -> Name -> DsM (Core Name)
globalVar Name
n
                Just (DsBound Id
x)  -> Core Name -> DsM (Core Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Core Name
coreVar Id
x)
                Just (DsSplice HsExpr GhcTc
_) -> String -> SDoc -> DsM (Core Name)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repE:lookupOcc" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
    }

globalVar :: Name -> DsM (Core TH.Name)
-- 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 Name)
globalVar Name
name
  | Name -> Bool
isExternalName Name
name
  = do  { MkC CoreExpr
mod <- String -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit String
name_mod
        ; MkC CoreExpr
pkg <- String -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit String
name_pkg
        ; MkC CoreExpr
occ <- Name -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
nameLit Name
name
        ; Name -> [CoreExpr] -> DsM (Core Name)
forall a. NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2_nwDsM Name
mk_varg [CoreExpr
pkg,CoreExpr
mod,CoreExpr
occ] }
  | Bool
otherwise
  = do  { MkC CoreExpr
occ <- Name -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
nameLit Name
name
        ; MkC CoreExpr
uni <- Integer -> IOEnv (Env DsGblEnv DsLclEnv) (Core Integer)
forall (m :: * -> *). MonadThings m => Integer -> m (Core Integer)
coreIntegerLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Unique -> Int
getKey (Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique Name
name))
        ; Name -> [CoreExpr] -> DsM (Core Name)
forall a. NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2_nwDsM Name
mkNameLName [CoreExpr
occ,CoreExpr
uni] }
  where
      mod :: Module
mod = ASSERT( isExternalName name) nameModule name
      name_mod :: String
name_mod = ModuleName -> String
moduleNameString (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
      name_pkg :: String
name_pkg = Unit -> String
unitString (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod)
      name_occ :: OccName
name_occ = Name -> OccName
nameOccName Name
name
      mk_varg :: Name
mk_varg | OccName -> Bool
isDataOcc OccName
name_occ = Name
mkNameG_dName
              | OccName -> Bool
isVarOcc  OccName
name_occ = Name
mkNameG_vName
              | OccName -> Bool
isTcOcc   OccName
name_occ = Name
mkNameG_tcName
              | Bool
otherwise          = String -> SDoc -> Name
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"GHC.HsToCore.Quote.globalVar" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)

lookupType :: Name      -- Name of type constructor (e.g. (M TH.Exp))
           -> MetaM Type  -- The type
lookupType :: Name -> MetaM Type
lookupType Name
tc_name = do { TyCon
tc <- DsM TyCon -> ReaderT MetaWrappers DsM TyCon
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM TyCon -> ReaderT MetaWrappers DsM TyCon)
-> DsM TyCon -> ReaderT MetaWrappers DsM TyCon
forall a b. (a -> b) -> a -> b
$ Name -> DsM TyCon
dsLookupTyCon Name
tc_name ;
                          Type -> MetaM Type
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> [Type] -> Type
mkTyConApp TyCon
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 a. [GenSymBind] -> Core (M a) -> MetaM (Core (M a))
wrapGenSyms [GenSymBind]
binds body :: Core (M a)
body@(MkC CoreExpr
b)
  = do  { Type
var_ty <- Name -> MetaM Type
lookupType Name
nameTyConName
        ; Type -> [GenSymBind] -> MetaM (Core (M a))
go Type
var_ty [GenSymBind]
binds }
  where
    (Type
_, Type
elt_ty) = Type -> (Type, Type)
tcSplitAppTy (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] -> MetaM (Core (M a))
go Type
_ [] = Core (M a) -> MetaM (Core (M a))
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M a)
body
    go Type
var_ty ((Name
name,Id
id) : [GenSymBind]
binds)
      = do { MkC CoreExpr
body'  <- Type -> [GenSymBind] -> MetaM (Core (M a))
go Type
var_ty [GenSymBind]
binds
           ; Core String
lit_str    <- IOEnv (Env DsGblEnv DsLclEnv) (Core String)
-> ReaderT MetaWrappers DsM (Core String)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env DsGblEnv DsLclEnv) (Core String)
 -> ReaderT MetaWrappers DsM (Core String))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
-> ReaderT MetaWrappers DsM (Core String)
forall a b. (a -> b) -> a -> b
$ Name -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
nameLit Name
name
           ; Core (M Name)
gensym_app <- Core String -> MetaM (Core (M Name))
repGensym Core String
lit_str
           ; Type
-> Type
-> Core (M Name)
-> Core (Name -> M a)
-> MetaM (Core (M a))
forall a b.
Type -> Type -> Core (M a) -> Core (a -> M b) -> MetaM (Core (M b))
repBindM Type
var_ty Type
elt_ty
                      Core (M Name)
gensym_app (CoreExpr -> Core (Name -> M a)
forall a. CoreExpr -> Core a
MkC (Id -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam Id
id CoreExpr
body')) }

nameLit :: Name -> DsM (Core String)
nameLit :: Name -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
nameLit Name
n = String -> IOEnv (Env DsGblEnv DsLclEnv) (Core String)
forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit (OccName -> String
occNameString (Name -> OccName
nameOccName Name
n))

occNameLit :: OccName -> MetaM (Core String)
occNameLit :: OccName -> ReaderT MetaWrappers DsM (Core String)
occNameLit OccName
name = String -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit (OccName -> String
occNameString 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 a. Core a -> CoreExpr
unC (MkC CoreExpr
x) = CoreExpr
x

type family NotM a where
  NotM (M _) = TypeError ('Text ("rep2_nw must not produce something of overloaded type"))
  NotM _other = (() :: Constraint)

rep2M :: Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 :: Name -> [CoreExpr] -> MetaM (Core (M a))
rep2_nw :: NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nwDsM :: NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2 :: forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 = (forall z. DsM z -> ReaderT MetaWrappers DsM z)
-> ReaderT MetaWrappers DsM (CoreExpr -> CoreExpr)
-> Name
-> [CoreExpr]
-> ReaderT MetaWrappers DsM (Core (M a))
forall (m :: * -> *) a.
Monad m =>
(forall z. DsM z -> m z)
-> m (CoreExpr -> CoreExpr) -> Name -> [CoreExpr] -> m (Core a)
rep2X forall z. DsM z -> ReaderT MetaWrappers DsM z
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((MetaWrappers -> CoreExpr -> CoreExpr)
-> ReaderT MetaWrappers DsM (CoreExpr -> CoreExpr)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks MetaWrappers -> CoreExpr -> CoreExpr
quoteWrapper)
rep2M :: forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2M = (forall z. DsM z -> ReaderT MetaWrappers DsM z)
-> ReaderT MetaWrappers DsM (CoreExpr -> CoreExpr)
-> Name
-> [CoreExpr]
-> ReaderT MetaWrappers DsM (Core (M a))
forall (m :: * -> *) a.
Monad m =>
(forall z. DsM z -> m z)
-> m (CoreExpr -> CoreExpr) -> Name -> [CoreExpr] -> m (Core a)
rep2X forall z. DsM z -> ReaderT MetaWrappers DsM z
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 = IOEnv (Env DsGblEnv DsLclEnv) (Core a)
-> ReaderT MetaWrappers DsM (Core a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Name -> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) (Core a)
forall a. NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2_nwDsM Name
n [CoreExpr]
xs)
rep2_nwDsM :: forall a. NotM a => Name -> [CoreExpr] -> DsM (Core a)
rep2_nwDsM = (forall z. DsM z -> DsM z)
-> DsM (CoreExpr -> CoreExpr)
-> Name
-> [CoreExpr]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core a)
forall (m :: * -> *) a.
Monad m =>
(forall z. DsM z -> m z)
-> m (CoreExpr -> CoreExpr) -> Name -> [CoreExpr] -> m (Core a)
rep2X forall a. a -> a
forall z. DsM z -> DsM z
id ((CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr -> CoreExpr
forall a. a -> a
id)

rep2X :: Monad m => (forall z . DsM z -> m z)
      -> m (CoreExpr -> CoreExpr)
      -> Name
      -> [ CoreExpr ]
      -> m (Core a)
rep2X :: forall (m :: * -> *) a.
Monad m =>
(forall z. DsM z -> m z)
-> m (CoreExpr -> CoreExpr) -> Name -> [CoreExpr] -> m (Core a)
rep2X forall z. DsM z -> m z
lift_dsm m (CoreExpr -> CoreExpr)
get_wrap Name
n [CoreExpr]
xs = do
  { Id
rep_id <- DsM Id -> m Id
forall z. DsM z -> m z
lift_dsm (DsM Id -> m Id) -> DsM Id -> m Id
forall a b. (a -> b) -> a -> b
$ Name -> DsM Id
dsLookupGlobalId Name
n
  ; CoreExpr -> CoreExpr
wrap <- m (CoreExpr -> CoreExpr)
get_wrap
  ; Core a -> m (Core a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core a
forall a. CoreExpr -> Core a
MkC (CoreExpr -> Core a) -> CoreExpr -> Core a
forall a b. (a -> b) -> a -> b
$ ((CoreExpr -> CoreExpr -> CoreExpr)
-> CoreExpr -> [CoreExpr] -> CoreExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (CoreExpr -> CoreExpr
wrap (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
rep_id)) [CoreExpr]
xs)) }


dataCon' :: Name -> [CoreExpr] -> MetaM (Core a)
dataCon' :: forall a. Name -> [CoreExpr] -> MetaM (Core a)
dataCon' Name
n [CoreExpr]
args = do { DataCon
id <- IOEnv (Env DsGblEnv DsLclEnv) DataCon
-> ReaderT MetaWrappers DsM DataCon
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env DsGblEnv DsLclEnv) DataCon
 -> ReaderT MetaWrappers DsM DataCon)
-> IOEnv (Env DsGblEnv DsLclEnv) DataCon
-> ReaderT MetaWrappers DsM DataCon
forall a b. (a -> b) -> a -> b
$ Name -> IOEnv (Env DsGblEnv DsLclEnv) DataCon
dsLookupDataCon Name
n
                     ; Core a -> MetaM (Core a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Core a -> MetaM (Core a)) -> Core a -> MetaM (Core a)
forall a b. (a -> b) -> a -> b
$ CoreExpr -> Core a
forall a. CoreExpr -> Core a
MkC (CoreExpr -> Core a) -> CoreExpr -> Core a
forall a b. (a -> b) -> a -> b
$ DataCon -> [CoreExpr] -> CoreExpr
mkCoreConApps DataCon
id [CoreExpr]
args }

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


-- %*********************************************************************
-- %*                                                                   *
--              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 a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
litPName [CoreExpr
l]

repPvar :: Core TH.Name -> MetaM (Core (M TH.Pat))
repPvar :: Core Name -> MetaM (Core (M Pat))
repPvar (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
varPName [CoreExpr
s]

repPtup :: Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
repPtup :: Core [M Pat] -> MetaM (Core (M Pat))
repPtup (MkC CoreExpr
ps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tupPName [CoreExpr
ps]

repPunboxedTup :: Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
repPunboxedTup :: Core [M Pat] -> MetaM (Core (M Pat))
repPunboxedTup (MkC CoreExpr
ps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedTupPName [CoreExpr
ps]

repPunboxedSum :: Core (M TH.Pat) -> TH.SumAlt -> TH.SumArity -> MetaM (Core (M TH.Pat))
-- 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
platform <- MetaM Platform
getPlatform
      ; Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedSumPName [ CoreExpr
p
                             , Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
alt
                             , Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
arity ] }

repPcon   :: Core TH.Name -> Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
repPcon :: Core Name -> Core [M Pat] -> MetaM (Core (M Pat))
repPcon (MkC CoreExpr
s) (MkC CoreExpr
ps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
conPName [CoreExpr
s, CoreExpr
ps]

repPrec   :: Core TH.Name -> Core [M (TH.Name, TH.Pat)] -> MetaM (Core (M TH.Pat))
repPrec :: Core Name -> Core [M (Name, Pat)] -> MetaM (Core (M Pat))
repPrec (MkC CoreExpr
c) (MkC CoreExpr
rps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recPName [CoreExpr
c,CoreExpr
rps]

repPinfix :: Core (M TH.Pat) -> Core TH.Name -> Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPinfix :: Core (M Pat) -> Core Name -> Core (M Pat) -> MetaM (Core (M Pat))
repPinfix (MkC CoreExpr
p1) (MkC CoreExpr
n) (MkC CoreExpr
p2) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixPName [CoreExpr
p1, CoreExpr
n, CoreExpr
p2]

repPtilde :: Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPtilde :: Core (M Pat) -> MetaM (Core (M Pat))
repPtilde (MkC CoreExpr
p) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tildePName [CoreExpr
p]

repPbang :: Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPbang :: Core (M Pat) -> MetaM (Core (M Pat))
repPbang (MkC CoreExpr
p) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
bangPName [CoreExpr
p]

repPaspat :: Core TH.Name -> Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPaspat :: Core Name -> Core (M Pat) -> MetaM (Core (M Pat))
repPaspat (MkC CoreExpr
s) (MkC CoreExpr
p) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
asPName [CoreExpr
s, CoreExpr
p]

repPwild  :: MetaM (Core (M TH.Pat))
repPwild :: MetaM (Core (M Pat))
repPwild = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
wildPName []

repPlist :: Core [(M TH.Pat)] -> MetaM (Core (M TH.Pat))
repPlist :: Core [M Pat] -> MetaM (Core (M Pat))
repPlist (MkC CoreExpr
ps) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
listPName [CoreExpr
ps]

repPview :: Core (M TH.Exp) -> Core (M TH.Pat) -> MetaM (Core (M TH.Pat))
repPview :: Core (M Exp) -> Core (M Pat) -> MetaM (Core (M Pat))
repPview (MkC CoreExpr
e) (MkC CoreExpr
p) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
viewPName [CoreExpr
e,CoreExpr
p]

repPsig :: Core (M TH.Pat) -> Core (M TH.Type) -> MetaM (Core (M TH.Pat))
repPsig :: Core (M Pat) -> Core (M Type) -> MetaM (Core (M Pat))
repPsig (MkC CoreExpr
p) (MkC CoreExpr
t) = Name -> [CoreExpr] -> MetaM (Core (M Pat))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sigPName [CoreExpr
p, CoreExpr
t]

--------------- 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 | OccName -> Bool
isDataOcc (Name -> OccName
nameOccName Name
vc) = Core Name -> MetaM (Core (M Exp))
repCon Core Name
str
                   | Bool
otherwise                  = Core Name -> MetaM (Core (M Exp))
repVar Core Name
str

repVar :: Core TH.Name -> MetaM (Core (M TH.Exp))
repVar :: Core Name -> MetaM (Core (M Exp))
repVar (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
varEName [CoreExpr
s]

repCon :: Core TH.Name -> MetaM (Core (M TH.Exp))
repCon :: Core Name -> MetaM (Core (M Exp))
repCon (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
conEName [CoreExpr
s]

repLit :: Core TH.Lit -> MetaM (Core (M TH.Exp))
repLit :: Core Lit -> MetaM (Core (M Exp))
repLit (MkC CoreExpr
c) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
litEName [CoreExpr
c]

repApp :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repApp :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repApp (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
appEName [CoreExpr
x,CoreExpr
y]

repAppType :: Core (M TH.Exp) -> Core (M TH.Type) -> MetaM (Core (M TH.Exp))
repAppType :: Core (M Exp) -> Core (M Type) -> MetaM (Core (M Exp))
repAppType (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
appTypeEName [CoreExpr
x,CoreExpr
y]

repLam :: Core [(M TH.Pat)] -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repLam :: Core [M Pat] -> Core (M Exp) -> MetaM (Core (M Exp))
repLam (MkC CoreExpr
ps) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
lamEName [CoreExpr
ps, CoreExpr
e]

repLamCase :: Core [(M TH.Match)] -> MetaM (Core (M TH.Exp))
repLamCase :: Core [M Match] -> MetaM (Core (M Exp))
repLamCase (MkC CoreExpr
ms) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
lamCaseEName [CoreExpr
ms]

repTup :: Core [Maybe (M TH.Exp)] -> MetaM (Core (M TH.Exp))
repTup :: Core [Maybe (M Exp)] -> MetaM (Core (M Exp))
repTup (MkC CoreExpr
es) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tupEName [CoreExpr
es]

repUnboxedTup :: Core [Maybe (M TH.Exp)] -> MetaM (Core (M TH.Exp))
repUnboxedTup :: Core [Maybe (M Exp)] -> MetaM (Core (M Exp))
repUnboxedTup (MkC CoreExpr
es) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedTupEName [CoreExpr
es]

repUnboxedSum :: Core (M TH.Exp) -> TH.SumAlt -> TH.SumArity -> MetaM (Core (M TH.Exp))
-- 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
platform <- MetaM Platform
getPlatform
      ; Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboxedSumEName [ CoreExpr
e
                             , Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
alt
                             , Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
arity ] }

repCond :: Core (M TH.Exp) -> Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repCond :: Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repCond (MkC CoreExpr
x) (MkC CoreExpr
y) (MkC CoreExpr
z) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
condEName [CoreExpr
x,CoreExpr
y,CoreExpr
z]

repMultiIf :: Core [M (TH.Guard, TH.Exp)] -> MetaM (Core (M TH.Exp))
repMultiIf :: Core [M (Guard, Exp)] -> MetaM (Core (M Exp))
repMultiIf (MkC CoreExpr
alts) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
multiIfEName [CoreExpr
alts]

repLetE :: Core [(M TH.Dec)] -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repLetE :: Core [M Dec] -> Core (M Exp) -> MetaM (Core (M Exp))
repLetE (MkC CoreExpr
ds) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
letEName [CoreExpr
ds, CoreExpr
e]

repCaseE :: Core (M TH.Exp) -> Core [(M TH.Match)] -> MetaM (Core (M TH.Exp))
repCaseE :: Core (M Exp) -> Core [M Match] -> MetaM (Core (M Exp))
repCaseE (MkC CoreExpr
e) (MkC CoreExpr
ms) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
caseEName [CoreExpr
e, CoreExpr
ms]

repDoE :: Maybe ModuleName -> Core [(M TH.Stmt)] -> MetaM (Core (M TH.Exp))
repDoE :: Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoE = Name -> Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoBlock Name
doEName

repMDoE :: Maybe ModuleName -> Core [(M TH.Stmt)] -> MetaM (Core (M TH.Exp))
repMDoE :: Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repMDoE = Name -> Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoBlock Name
mdoEName

repDoBlock :: Name -> Maybe ModuleName -> Core [(M TH.Stmt)] -> MetaM (Core (M TH.Exp))
repDoBlock :: Name -> Maybe ModuleName -> Core [M Stmt] -> MetaM (Core (M Exp))
repDoBlock Name
doName Maybe ModuleName
maybeModName (MkC CoreExpr
ss) = do
    MkC CoreExpr
coreModName <- MetaM (Core (Maybe ModName))
coreModNameM
    Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
doName [CoreExpr
coreModName, CoreExpr
ss]
  where
    coreModNameM :: MetaM (Core (Maybe TH.ModName))
    coreModNameM :: MetaM (Core (Maybe ModName))
coreModNameM = case Maybe ModuleName
maybeModName of
      Just ModuleName
m -> do
        MkC CoreExpr
s <- String -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit (ModuleName -> String
moduleNameString ModuleName
m)
        Core ModName
mName <- Name -> [CoreExpr] -> MetaM (Core ModName)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
mkModNameName [CoreExpr
s]
        Name -> Core ModName -> MetaM (Core (Maybe ModName))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJust Name
modNameTyConName Core ModName
mName
      Maybe ModuleName
_ -> Name -> MetaM (Core (Maybe ModName))
forall a. Name -> MetaM (Core (Maybe a))
coreNothing Name
modNameTyConName

repComp :: Core [(M TH.Stmt)] -> MetaM (Core (M TH.Exp))
repComp :: Core [M Stmt] -> MetaM (Core (M Exp))
repComp (MkC CoreExpr
ss) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
compEName [CoreExpr
ss]

repListExp :: Core [(M TH.Exp)] -> MetaM (Core (M TH.Exp))
repListExp :: Core [M Exp] -> MetaM (Core (M Exp))
repListExp (MkC CoreExpr
es) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
listEName [CoreExpr
es]

repSigExp :: Core (M TH.Exp) -> Core (M TH.Type) -> MetaM (Core (M TH.Exp))
repSigExp :: Core (M Exp) -> Core (M Type) -> MetaM (Core (M Exp))
repSigExp (MkC CoreExpr
e) (MkC CoreExpr
t) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sigEName [CoreExpr
e,CoreExpr
t]

repRecCon :: Core TH.Name -> Core [M TH.FieldExp]-> MetaM (Core (M TH.Exp))
repRecCon :: Core Name -> Core [M FieldExp] -> MetaM (Core (M Exp))
repRecCon (MkC CoreExpr
c) (MkC CoreExpr
fs) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recConEName [CoreExpr
c,CoreExpr
fs]

repRecUpd :: Core (M TH.Exp) -> Core [M TH.FieldExp] -> MetaM (Core (M TH.Exp))
repRecUpd :: Core (M Exp) -> Core [M FieldExp] -> MetaM (Core (M Exp))
repRecUpd (MkC CoreExpr
e) (MkC CoreExpr
fs) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recUpdEName [CoreExpr
e,CoreExpr
fs]

repFieldExp :: Core TH.Name -> Core (M TH.Exp) -> MetaM (Core (M TH.FieldExp))
repFieldExp :: Core Name -> Core (M Exp) -> MetaM (Core (M FieldExp))
repFieldExp (MkC CoreExpr
n) (MkC CoreExpr
x) = Name -> [CoreExpr] -> MetaM (Core (M FieldExp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fieldExpName [CoreExpr
n,CoreExpr
x]

repInfixApp :: Core (M TH.Exp) -> Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repInfixApp :: Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repInfixApp (MkC CoreExpr
x) (MkC CoreExpr
y) (MkC CoreExpr
z) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixAppName [CoreExpr
x,CoreExpr
y,CoreExpr
z]

repSectionL :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repSectionL :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repSectionL (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sectionLName [CoreExpr
x,CoreExpr
y]

repSectionR :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repSectionR :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repSectionR (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sectionRName [CoreExpr
x,CoreExpr
y]

repImplicitParamVar :: Core String -> MetaM (Core (M TH.Exp))
repImplicitParamVar :: Core String -> MetaM (Core (M Exp))
repImplicitParamVar (MkC CoreExpr
x) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
implicitParamVarEName [CoreExpr
x]

------------ 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 a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
guardedBName [CoreExpr
pairs]

repNormal :: Core (M TH.Exp) -> MetaM (Core (M TH.Body))
repNormal :: Core (M Exp) -> MetaM (Core (M Body))
repNormal (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Body))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
normalBName [CoreExpr
e]

------------ Guards ----
repLNormalGE :: LHsExpr GhcRn -> LHsExpr GhcRn
             -> MetaM (Core (M (TH.Guard, TH.Exp)))
repLNormalGE :: LHsExpr GhcRn -> LHsExpr GhcRn -> MetaM (Core (M (Guard, Exp)))
repLNormalGE LHsExpr GhcRn
g LHsExpr GhcRn
e = do Core (M Exp)
g' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
g
                      Core (M Exp)
e' <- LHsExpr GhcRn -> MetaM (Core (M Exp))
repLE LHsExpr GhcRn
e
                      Core (M Exp) -> Core (M Exp) -> MetaM (Core (M (Guard, Exp)))
repNormalGE Core (M Exp)
g' Core (M Exp)
e'

repNormalGE :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M (TH.Guard, TH.Exp)))
repNormalGE :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M (Guard, Exp)))
repNormalGE (MkC CoreExpr
g) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M (Guard, Exp)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
normalGEName [CoreExpr
g, CoreExpr
e]

repPatGE :: Core [(M TH.Stmt)] -> Core (M TH.Exp) -> MetaM (Core (M (TH.Guard, TH.Exp)))
repPatGE :: Core [M Stmt] -> Core (M Exp) -> MetaM (Core (M (Guard, Exp)))
repPatGE (MkC CoreExpr
ss) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M (Guard, Exp)))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
patGEName [CoreExpr
ss, CoreExpr
e]

------------- 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 a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
bindSName [CoreExpr
p,CoreExpr
e]

repLetSt :: Core [(M TH.Dec)] -> MetaM (Core (M TH.Stmt))
repLetSt :: Core [M Dec] -> MetaM (Core (M Stmt))
repLetSt (MkC CoreExpr
ds) = Name -> [CoreExpr] -> MetaM (Core (M Stmt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
letSName [CoreExpr
ds]

repNoBindSt :: Core (M TH.Exp) -> MetaM (Core (M TH.Stmt))
repNoBindSt :: Core (M Exp) -> MetaM (Core (M Stmt))
repNoBindSt (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Stmt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
noBindSName [CoreExpr
e]

repParSt :: Core [[(M TH.Stmt)]] -> MetaM (Core (M TH.Stmt))
repParSt :: Core [[M Stmt]] -> MetaM (Core (M Stmt))
repParSt (MkC CoreExpr
sss) = Name -> [CoreExpr] -> MetaM (Core (M Stmt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
parSName [CoreExpr
sss]

repRecSt :: Core [(M TH.Stmt)] -> MetaM (Core (M TH.Stmt))
repRecSt :: Core [M Stmt] -> MetaM (Core (M Stmt))
repRecSt (MkC CoreExpr
ss) = Name -> [CoreExpr] -> MetaM (Core (M Stmt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recSName [CoreExpr
ss]

-------------- 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 a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fromEName [CoreExpr
x]

repFromThen :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repFromThen :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repFromThen (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fromThenEName [CoreExpr
x,CoreExpr
y]

repFromTo :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repFromTo :: Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repFromTo (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fromToEName [CoreExpr
x,CoreExpr
y]

repFromThenTo :: Core (M TH.Exp) -> Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M TH.Exp))
repFromThenTo :: Core (M Exp)
-> Core (M Exp) -> Core (M Exp) -> MetaM (Core (M Exp))
repFromThenTo (MkC CoreExpr
x) (MkC CoreExpr
y) (MkC CoreExpr
z) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
fromThenToEName [CoreExpr
x,CoreExpr
y,CoreExpr
z]

------------ 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 a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
matchName [CoreExpr
p, CoreExpr
bod, CoreExpr
ds]

repClause :: Core [(M TH.Pat)] -> Core (M TH.Body) -> Core [(M TH.Dec)] -> MetaM (Core (M TH.Clause))
repClause :: Core [M Pat]
-> Core (M Body) -> Core [M Dec] -> MetaM (Core (M Clause))
repClause (MkC CoreExpr
ps) (MkC CoreExpr
bod) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> MetaM (Core (M Clause))
forall a. 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 a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
valDName [CoreExpr
p, CoreExpr
b, CoreExpr
ds]

repFun :: Core TH.Name -> Core [(M TH.Clause)] -> MetaM (Core (M TH.Dec))
repFun :: Core Name -> Core [M Clause] -> MetaM (Core (M Dec))
repFun (MkC CoreExpr
nm) (MkC CoreExpr
b) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
funDName [CoreExpr
nm, CoreExpr
b]

repData :: Core (M TH.Cxt) -> Core TH.Name
        -> Either (Core [(M (TH.TyVarBndr ()))])
                  (Core (Maybe [(M (TH.TyVarBndr ()))]), Core (M TH.Type))
        -> Core (Maybe (M TH.Kind)) -> Core [(M TH.Con)] -> Core [M TH.DerivClause]
        -> MetaM (Core (M TH.Dec))
repData :: Core (M Cxt)
-> Core Name
-> Either
     (Core [M (TyVarBndr ())])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Core (Maybe (M Type))
-> Core [M Con]
-> Core [M DerivClause]
-> MetaM (Core (M Dec))
repData (MkC CoreExpr
cxt) (MkC CoreExpr
nm) (Left (MkC CoreExpr
tvs)) (MkC CoreExpr
ksig) (MkC CoreExpr
cons) (MkC CoreExpr
derivs)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
dataDName [CoreExpr
cxt, CoreExpr
nm, CoreExpr
tvs, CoreExpr
ksig, CoreExpr
cons, CoreExpr
derivs]
repData (MkC CoreExpr
cxt) (MkC CoreExpr
_) (Right (MkC CoreExpr
mb_bndrs, MkC CoreExpr
ty)) (MkC CoreExpr
ksig) (MkC CoreExpr
cons)
        (MkC CoreExpr
derivs)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
dataInstDName [CoreExpr
cxt, CoreExpr
mb_bndrs, CoreExpr
ty, CoreExpr
ksig, CoreExpr
cons, CoreExpr
derivs]

repNewtype :: Core (M TH.Cxt) -> Core TH.Name
           -> Either (Core [(M (TH.TyVarBndr ()))])
                     (Core (Maybe [(M (TH.TyVarBndr ()))]), Core (M TH.Type))
           -> Core (Maybe (M TH.Kind)) -> Core (M TH.Con) -> Core [M TH.DerivClause]
           -> MetaM (Core (M TH.Dec))
repNewtype :: Core (M Cxt)
-> Core Name
-> Either
     (Core [M (TyVarBndr ())])
     (Core (Maybe [M (TyVarBndr ())]), Core (M Type))
-> Core (Maybe (M Type))
-> Core (M Con)
-> Core [M DerivClause]
-> MetaM (Core (M Dec))
repNewtype (MkC CoreExpr
cxt) (MkC CoreExpr
nm) (Left (MkC CoreExpr
tvs)) (MkC CoreExpr
ksig) (MkC CoreExpr
con)
           (MkC CoreExpr
derivs)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
newtypeDName [CoreExpr
cxt, CoreExpr
nm, CoreExpr
tvs, CoreExpr
ksig, CoreExpr
con, CoreExpr
derivs]
repNewtype (MkC CoreExpr
cxt) (MkC CoreExpr
_) (Right (MkC CoreExpr
mb_bndrs, MkC CoreExpr
ty)) (MkC CoreExpr
ksig) (MkC CoreExpr
con)
           (MkC CoreExpr
derivs)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
newtypeInstDName [CoreExpr
cxt, CoreExpr
mb_bndrs, CoreExpr
ty, CoreExpr
ksig, CoreExpr
con, CoreExpr
derivs]

repTySyn :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
         -> Core (M TH.Type) -> MetaM (Core (M TH.Dec))
repTySyn :: Core Name
-> Core [M (TyVarBndr ())] -> Core (M Type) -> MetaM (Core (M Dec))
repTySyn (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
rhs)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tySynDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
rhs]

repInst :: Core (Maybe TH.Overlap) ->
           Core (M TH.Cxt) -> Core (M TH.Type) -> Core [(M TH.Dec)] -> MetaM (Core (M TH.Dec))
repInst :: Core (Maybe Overlap)
-> Core (M Cxt)
-> Core (M Type)
-> Core [M Dec]
-> MetaM (Core (M Dec))
repInst (MkC CoreExpr
o) (MkC CoreExpr
cxt) (MkC CoreExpr
ty) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
instanceWithOverlapDName
                                                              [CoreExpr
o, CoreExpr
cxt, CoreExpr
ty, CoreExpr
ds]

repDerivStrategy :: Maybe (LDerivStrategy GhcRn)
                 -> (Core (Maybe (M TH.DerivStrategy)) -> MetaM (Core (M a)))
                 -> MetaM (Core (M a))
repDerivStrategy :: forall a.
Maybe (LDerivStrategy GhcRn)
-> (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> MetaM (Core (M a))
repDerivStrategy Maybe (LDerivStrategy GhcRn)
mds Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside =
  case Maybe (LDerivStrategy GhcRn)
mds of
    Maybe (LDerivStrategy GhcRn)
Nothing -> Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
-> MetaM (Core (M a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall {a}. MetaM (Core (Maybe a))
nothing
    Just LDerivStrategy GhcRn
ds ->
      case LDerivStrategy GhcRn -> DerivStrategy GhcRn
forall l e. GenLocated l e -> e
unLoc LDerivStrategy GhcRn
ds of
        DerivStrategy GhcRn
StockStrategy    -> 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
        DerivStrategy GhcRn
AnyclassStrategy -> 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
        DerivStrategy GhcRn
NewtypeStrategy  -> Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside (Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a)))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
-> MetaM (Core (M a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Core (M DerivStrategy)
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core (M DerivStrategy)
 -> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy))))
-> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repNewtypeStrategy
        ViaStrategy XViaStrategy GhcRn
ty   -> [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a. [Name] -> MetaM (Core (M a)) -> MetaM (Core (M a))
addSimpleTyVarBinds (LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig XViaStrategy GhcRn
LHsSigType GhcRn
ty) (MetaM (Core (M a)) -> MetaM (Core (M a)))
-> MetaM (Core (M a)) -> MetaM (Core (M a))
forall a b. (a -> b) -> a -> b
$
                            do Core (M Type)
ty' <- LHsSigType GhcRn -> MetaM (Core (M Type))
rep_ty_sig' XViaStrategy GhcRn
LHsSigType GhcRn
ty
                               Core (M DerivStrategy)
via_strat <- Core (M Type) -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repViaStrategy Core (M Type)
ty'
                               Core (Maybe (M DerivStrategy))
m_via_strat <- Core (M DerivStrategy)
-> ReaderT MetaWrappers DsM (Core (Maybe (M DerivStrategy)))
forall {a}. Core a -> MetaM (Core (Maybe a))
just Core (M DerivStrategy)
via_strat
                               Core (Maybe (M DerivStrategy)) -> MetaM (Core (M a))
thing_inside Core (Maybe (M DerivStrategy))
m_via_strat
  where
  nothing :: MetaM (Core (Maybe a))
nothing = Name -> MetaM (Core (Maybe a))
forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
derivStrategyTyConName
  just :: Core a -> MetaM (Core (Maybe a))
just    = Name -> Core a -> MetaM (Core (Maybe a))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJustM    Name
derivStrategyTyConName

repStockStrategy :: MetaM (Core (M TH.DerivStrategy))
repStockStrategy :: ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repStockStrategy = Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
stockStrategyName []

repAnyclassStrategy :: MetaM (Core (M TH.DerivStrategy))
repAnyclassStrategy :: ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repAnyclassStrategy = Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
anyclassStrategyName []

repNewtypeStrategy :: MetaM (Core (M TH.DerivStrategy))
repNewtypeStrategy :: ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repNewtypeStrategy = Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
newtypeStrategyName []

repViaStrategy :: Core (M TH.Type) -> MetaM (Core (M TH.DerivStrategy))
repViaStrategy :: Core (M Type) -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
repViaStrategy (MkC CoreExpr
t) = Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M DerivStrategy))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
viaStrategyName [CoreExpr
t]

repOverlap :: Maybe OverlapMode -> MetaM (Core (Maybe TH.Overlap))
repOverlap :: Maybe OverlapMode -> MetaM (Core (Maybe Overlap))
repOverlap Maybe OverlapMode
mb =
  case Maybe OverlapMode
mb of
    Maybe OverlapMode
Nothing -> MetaM (Core (Maybe Overlap))
forall {a}. MetaM (Core (Maybe a))
nothing
    Just OverlapMode
o ->
      case OverlapMode
o of
        NoOverlap SourceText
_    -> MetaM (Core (Maybe Overlap))
forall {a}. MetaM (Core (Maybe a))
nothing
        Overlappable SourceText
_ -> Core Overlap -> MetaM (Core (Maybe Overlap))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core Overlap -> MetaM (Core (Maybe Overlap)))
-> ReaderT MetaWrappers DsM (Core Overlap)
-> MetaM (Core (Maybe Overlap))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> ReaderT MetaWrappers DsM (Core Overlap)
forall a. Name -> MetaM (Core a)
dataCon Name
overlappableDataConName
        Overlapping SourceText
_  -> Core Overlap -> MetaM (Core (Maybe Overlap))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core Overlap -> MetaM (Core (Maybe Overlap)))
-> ReaderT MetaWrappers DsM (Core Overlap)
-> MetaM (Core (Maybe Overlap))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> ReaderT MetaWrappers DsM (Core Overlap)
forall a. Name -> MetaM (Core a)
dataCon Name
overlappingDataConName
        Overlaps SourceText
_     -> Core Overlap -> MetaM (Core (Maybe Overlap))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core Overlap -> MetaM (Core (Maybe Overlap)))
-> ReaderT MetaWrappers DsM (Core Overlap)
-> MetaM (Core (Maybe Overlap))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> ReaderT MetaWrappers DsM (Core Overlap)
forall a. Name -> MetaM (Core a)
dataCon Name
overlapsDataConName
        Incoherent SourceText
_   -> Core Overlap -> MetaM (Core (Maybe Overlap))
forall {a}. Core a -> MetaM (Core (Maybe a))
just (Core Overlap -> MetaM (Core (Maybe Overlap)))
-> ReaderT MetaWrappers DsM (Core Overlap)
-> MetaM (Core (Maybe Overlap))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> ReaderT MetaWrappers DsM (Core Overlap)
forall a. Name -> MetaM (Core a)
dataCon Name
incoherentDataConName
  where
  nothing :: MetaM (Core (Maybe a))
nothing = Name -> MetaM (Core (Maybe a))
forall a. Name -> MetaM (Core (Maybe a))
coreNothing Name
overlapTyConName
  just :: Core a -> MetaM (Core (Maybe a))
just    = Name -> Core a -> MetaM (Core (Maybe a))
forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJust Name
overlapTyConName


repClass :: Core (M TH.Cxt) -> Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
         -> Core [TH.FunDep] -> Core [(M TH.Dec)]
         -> MetaM (Core (M TH.Dec))
repClass :: Core (M Cxt)
-> Core Name
-> Core [M (TyVarBndr ())]
-> Core [FunDep]
-> Core [M Dec]
-> MetaM (Core (M Dec))
repClass (MkC CoreExpr
cxt) (MkC CoreExpr
cls) (MkC CoreExpr
tvs) (MkC CoreExpr
fds) (MkC CoreExpr
ds)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
classDName [CoreExpr
cxt, CoreExpr
cls, CoreExpr
tvs, CoreExpr
fds, CoreExpr
ds]

repDeriv :: Core (Maybe (M TH.DerivStrategy))
         -> Core (M TH.Cxt) -> Core (M TH.Type)
         -> MetaM (Core (M TH.Dec))
repDeriv :: Core (Maybe (M DerivStrategy))
-> Core (M Cxt) -> Core (M Type) -> MetaM (Core (M Dec))
repDeriv (MkC CoreExpr
ds) (MkC CoreExpr
cxt) (MkC CoreExpr
ty)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
standaloneDerivWithStrategyDName [CoreExpr
ds, CoreExpr
cxt, CoreExpr
ty]

repPragInl :: Core TH.Name -> Core TH.Inline -> Core TH.RuleMatch
           -> Core TH.Phases -> MetaM (Core (M TH.Dec))
repPragInl :: Core Name
-> Core Inline
-> Core RuleMatch
-> Core Phases
-> MetaM (Core (M Dec))
repPragInl (MkC CoreExpr
nm) (MkC CoreExpr
inline) (MkC CoreExpr
rm) (MkC CoreExpr
phases)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragInlDName [CoreExpr
nm, CoreExpr
inline, CoreExpr
rm, CoreExpr
phases]

repPragSpec :: Core TH.Name -> Core (M TH.Type) -> Core TH.Phases
            -> MetaM (Core (M TH.Dec))
repPragSpec :: Core Name -> Core (M Type) -> Core Phases -> MetaM (Core (M Dec))
repPragSpec (MkC CoreExpr
nm) (MkC CoreExpr
ty) (MkC CoreExpr
phases)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecDName [CoreExpr
nm, CoreExpr
ty, CoreExpr
phases]

repPragSpecInl :: Core TH.Name -> Core (M TH.Type) -> Core TH.Inline
               -> Core TH.Phases -> MetaM (Core (M TH.Dec))
repPragSpecInl :: Core Name
-> Core (M Type)
-> Core Inline
-> Core Phases
-> MetaM (Core (M Dec))
repPragSpecInl (MkC CoreExpr
nm) (MkC CoreExpr
ty) (MkC CoreExpr
inline) (MkC CoreExpr
phases)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecInlDName [CoreExpr
nm, CoreExpr
ty, CoreExpr
inline, CoreExpr
phases]

repPragSpecInst :: Core (M TH.Type) -> MetaM (Core (M TH.Dec))
repPragSpecInst :: Core (M Type) -> MetaM (Core (M Dec))
repPragSpecInst (MkC CoreExpr
ty) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragSpecInstDName [CoreExpr
ty]

repPragComplete :: Core [TH.Name] -> Core (Maybe TH.Name) -> MetaM (Core (M TH.Dec))
repPragComplete :: Core [Name] -> Core (Maybe Name) -> MetaM (Core (M Dec))
repPragComplete (MkC CoreExpr
cls) (MkC CoreExpr
mty) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragCompleteDName [CoreExpr
cls, CoreExpr
mty]

repPragRule :: Core String -> Core (Maybe [(M (TH.TyVarBndr ()))])
            -> Core [(M TH.RuleBndr)] -> Core (M TH.Exp) -> Core (M TH.Exp)
            -> Core TH.Phases -> MetaM (Core (M TH.Dec))
repPragRule :: Core String
-> Core (Maybe [M (TyVarBndr ())])
-> Core [M RuleBndr]
-> Core (M Exp)
-> Core (M Exp)
-> Core Phases
-> MetaM (Core (M Dec))
repPragRule (MkC CoreExpr
nm) (MkC CoreExpr
ty_bndrs) (MkC CoreExpr
tm_bndrs) (MkC CoreExpr
lhs) (MkC CoreExpr
rhs) (MkC CoreExpr
phases)
  = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragRuleDName [CoreExpr
nm, CoreExpr
ty_bndrs, CoreExpr
tm_bndrs, CoreExpr
lhs, CoreExpr
rhs, CoreExpr
phases]

repPragAnn :: Core TH.AnnTarget -> Core (M TH.Exp) -> MetaM (Core (M TH.Dec))
repPragAnn :: Core AnnTarget -> Core (M Exp) -> MetaM (Core (M Dec))
repPragAnn (MkC CoreExpr
targ) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
pragAnnDName [CoreExpr
targ, CoreExpr
e]

repTySynInst :: Core (M TH.TySynEqn) -> MetaM (Core (M TH.Dec))
repTySynInst :: Core (M TySynEqn) -> MetaM (Core (M Dec))
repTySynInst (MkC CoreExpr
eqn)
    = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tySynInstDName [CoreExpr
eqn]

repDataFamilyD :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
               -> Core (Maybe (M TH.Kind)) -> MetaM (Core (M TH.Dec))
repDataFamilyD :: Core Name
-> Core [M (TyVarBndr ())]
-> Core (Maybe (M Type))
-> MetaM (Core (M Dec))
repDataFamilyD (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
kind)
    = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
dataFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
kind]

repOpenFamilyD :: Core TH.Name
               -> Core [(M (TH.TyVarBndr ()))]
               -> Core (M TH.FamilyResultSig)
               -> Core (Maybe TH.InjectivityAnn)
               -> MetaM (Core (M TH.Dec))
repOpenFamilyD :: Core Name
-> Core [M (TyVarBndr ())]
-> Core (M FamilyResultSig)
-> Core (Maybe InjectivityAnn)
-> MetaM (Core (M Dec))
repOpenFamilyD (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
result) (MkC CoreExpr
inj)
    = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
openTypeFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
result, CoreExpr
inj]

repClosedFamilyD :: Core TH.Name
                 -> Core [(M (TH.TyVarBndr ()))]
                 -> Core (M TH.FamilyResultSig)
                 -> Core (Maybe TH.InjectivityAnn)
                 -> Core [(M TH.TySynEqn)]
                 -> MetaM (Core (M TH.Dec))
repClosedFamilyD :: Core Name
-> Core [M (TyVarBndr ())]
-> Core (M FamilyResultSig)
-> Core (Maybe InjectivityAnn)
-> Core [M TySynEqn]
-> MetaM (Core (M Dec))
repClosedFamilyD (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
res) (MkC CoreExpr
inj) (MkC CoreExpr
eqns)
    = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
closedTypeFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
res, CoreExpr
inj, CoreExpr
eqns]

repTySynEqn :: Core (Maybe [(M (TH.TyVarBndr ()))]) ->
               Core (M TH.Type) -> Core (M TH.Type) -> MetaM (Core (M TH.TySynEqn))
repTySynEqn :: Core (Maybe [M (TyVarBndr ())])
-> Core (M Type)
-> Core (M Type)
-> ReaderT MetaWrappers DsM (Core (M TySynEqn))
repTySynEqn (MkC CoreExpr
mb_bndrs) (MkC CoreExpr
lhs) (MkC CoreExpr
rhs)
  = Name -> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M TySynEqn))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tySynEqnName [CoreExpr
mb_bndrs, CoreExpr
lhs, CoreExpr
rhs]

repRoleAnnotD :: Core TH.Name -> Core [TH.Role] -> MetaM (Core (M TH.Dec))
repRoleAnnotD :: Core Name -> Core [Role] -> MetaM (Core (M Dec))
repRoleAnnotD (MkC CoreExpr
n) (MkC CoreExpr
roles) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
roleAnnotDName [CoreExpr
n, CoreExpr
roles]

repFunDep :: Core [TH.Name] -> Core [TH.Name] -> MetaM (Core TH.FunDep)
repFunDep :: Core [Name] -> Core [Name] -> MetaM (Core FunDep)
repFunDep (MkC CoreExpr
xs) (MkC CoreExpr
ys) = Name -> [CoreExpr] -> MetaM (Core FunDep)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
funDepName [CoreExpr
xs, CoreExpr
ys]

repProto :: Name -> Core TH.Name -> Core (M TH.Type) -> MetaM (Core (M TH.Dec))
repProto :: Name -> Core Name -> Core (M Type) -> MetaM (Core (M Dec))
repProto Name
mk_sig (MkC CoreExpr
s) (MkC CoreExpr
ty) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
mk_sig [CoreExpr
s, CoreExpr
ty]

repImplicitParamBind :: Core String -> Core (M TH.Exp) -> MetaM (Core (M TH.Dec))
repImplicitParamBind :: Core String -> Core (M Exp) -> MetaM (Core (M Dec))
repImplicitParamBind (MkC CoreExpr
n) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Dec))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
implicitParamBindDName [CoreExpr
n, CoreExpr
e]

repCtxt :: Core [(M TH.Pred)] -> MetaM (Core (M TH.Cxt))
repCtxt :: Core [M Type] -> MetaM (Core (M Cxt))
repCtxt (MkC CoreExpr
tys) = Name -> [CoreExpr] -> MetaM (Core (M Cxt))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
cxtName [CoreExpr
tys]

repDataCon :: Located Name
           -> HsConDeclDetails GhcRn
           -> MetaM (Core (M TH.Con))
repDataCon :: Located Name -> HsConDeclDetails GhcRn -> MetaM (Core (M Con))
repDataCon Located Name
con HsConDeclDetails GhcRn
details
    = do Core Name
con' <- Located Name -> MetaM (Core Name)
lookupLOcc Located Name
con -- See Note [Binders and occurrences]
         HsConDeclDetails GhcRn
-> Maybe (LHsType GhcRn) -> [Core Name] -> MetaM (Core (M Con))
repConstr HsConDeclDetails GhcRn
details Maybe (LHsType GhcRn)
forall a. Maybe a
Nothing [Core Name
con']

repGadtDataCons :: [Located Name]
                -> HsConDeclDetails GhcRn
                -> LHsType GhcRn
                -> MetaM (Core (M TH.Con))
repGadtDataCons :: [Located Name]
-> HsConDeclDetails GhcRn -> LHsType GhcRn -> MetaM (Core (M Con))
repGadtDataCons [Located Name]
cons HsConDeclDetails GhcRn
details LHsType GhcRn
res_ty
    = do [Core Name]
cons' <- (Located Name -> MetaM (Core Name))
-> [Located Name] -> ReaderT MetaWrappers DsM [Core Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located Name -> MetaM (Core Name)
lookupLOcc [Located Name]
cons -- See Note [Binders and occurrences]
         HsConDeclDetails GhcRn
-> Maybe (LHsType GhcRn) -> [Core Name] -> MetaM (Core (M Con))
repConstr HsConDeclDetails GhcRn
details (LHsType GhcRn -> Maybe (LHsType GhcRn)
forall a. a -> Maybe a
Just LHsType GhcRn
res_ty) [Core Name]
cons'

-- Invariant:
--   * for plain H98 data constructors second argument is Nothing and third
--     argument is a singleton list
--   * for GADTs data constructors second argument is (Just return_type) and
--     third argument is a non-empty list
repConstr :: HsConDeclDetails GhcRn
          -> Maybe (LHsType GhcRn)
          -> [Core TH.Name]
          -> MetaM (Core (M TH.Con))
repConstr :: HsConDeclDetails GhcRn
-> Maybe (LHsType GhcRn) -> [Core Name] -> MetaM (Core (M Con))
repConstr (PrefixCon [HsScaled GhcRn (LHsType GhcRn)]
ps) Maybe (LHsType GhcRn)
Nothing [Core Name
con]
    = do Core [M BangType]
arg_tys  <- Name
-> (LHsType GhcRn -> MetaM (Core (M BangType)))
-> HsContext GhcRn
-> MetaM (Core [M BangType])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
bangTypeTyConName LHsType GhcRn -> MetaM (Core (M BangType))
repBangTy ((HsScaled GhcRn (LHsType GhcRn) -> LHsType GhcRn)
-> [HsScaled GhcRn (LHsType GhcRn)] -> HsContext GhcRn
forall a b. (a -> b) -> [a] -> [b]
map HsScaled GhcRn (LHsType GhcRn) -> LHsType GhcRn
forall pass a. HsScaled pass a -> a
hsScaledThing [HsScaled GhcRn (LHsType GhcRn)]
ps)
         Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
normalCName [Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC Core Name
con, Core [M BangType] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M BangType]
arg_tys]

repConstr (PrefixCon [HsScaled GhcRn (LHsType GhcRn)]
ps) (Just LHsType GhcRn
res_ty) [Core Name]
cons
    = do Core [M BangType]
arg_tys     <- Name
-> (LHsType GhcRn -> MetaM (Core (M BangType)))
-> HsContext GhcRn
-> MetaM (Core [M BangType])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
bangTypeTyConName LHsType GhcRn -> MetaM (Core (M BangType))
repBangTy ((HsScaled GhcRn (LHsType GhcRn) -> LHsType GhcRn)
-> [HsScaled GhcRn (LHsType GhcRn)] -> HsContext GhcRn
forall a b. (a -> b) -> [a] -> [b]
map HsScaled GhcRn (LHsType GhcRn) -> LHsType GhcRn
forall pass a. HsScaled pass a -> a
hsScaledThing [HsScaled GhcRn (LHsType GhcRn)]
ps)
         Core (M Type)
res_ty' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
res_ty
         Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
gadtCName [ Core [Name] -> CoreExpr
forall a. Core a -> CoreExpr
unC ([Core Name] -> Core [Name]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core Name]
cons), Core [M BangType] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M BangType]
arg_tys, Core (M Type) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Type)
res_ty']

repConstr (RecCon Located [LConDeclField GhcRn]
ips) Maybe (LHsType GhcRn)
resTy [Core Name]
cons
    = do [Core (M VarBangType)]
args     <- (LConDeclField GhcRn
 -> ReaderT MetaWrappers DsM [Core (M VarBangType)])
-> [LConDeclField GhcRn]
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM LConDeclField GhcRn
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
forall {l}.
GenLocated l (ConDeclField GhcRn)
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
rep_ip (Located [LConDeclField GhcRn] -> [LConDeclField GhcRn]
forall l e. GenLocated l e -> e
unLoc Located [LConDeclField GhcRn]
ips)
         Core [M VarBangType]
arg_vtys <- Name -> [Core (M VarBangType)] -> MetaM (Core [M VarBangType])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
varBangTypeTyConName [Core (M VarBangType)]
args
         case Maybe (LHsType GhcRn)
resTy of
           Maybe (LHsType GhcRn)
Nothing -> Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recCName [Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC ([Core Name] -> Core Name
forall a. [a] -> a
head [Core Name]
cons), Core [M VarBangType] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M VarBangType]
arg_vtys]
           Just LHsType GhcRn
res_ty -> do
             Core (M Type)
res_ty' <- LHsType GhcRn -> MetaM (Core (M Type))
repLTy LHsType GhcRn
res_ty
             Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
recGadtCName [Core [Name] -> CoreExpr
forall a. Core a -> CoreExpr
unC ([Core Name] -> Core [Name]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core Name]
cons), Core [M VarBangType] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [M VarBangType]
arg_vtys,
                                Core (M Type) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M Type)
res_ty']

    where
      rep_ip :: GenLocated l (ConDeclField GhcRn)
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
rep_ip (L l
_ ConDeclField GhcRn
ip) = (LFieldOcc GhcRn
 -> ReaderT MetaWrappers DsM (Core (M VarBangType)))
-> [LFieldOcc GhcRn]
-> ReaderT MetaWrappers DsM [Core (M VarBangType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (LHsType GhcRn
-> LFieldOcc GhcRn
-> ReaderT MetaWrappers DsM (Core (M VarBangType))
rep_one_ip (ConDeclField GhcRn -> LHsType GhcRn
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type ConDeclField GhcRn
ip)) (ConDeclField GhcRn -> [LFieldOcc GhcRn]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names ConDeclField GhcRn
ip)

      rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> MetaM (Core (M TH.VarBangType))
      rep_one_ip :: LHsType GhcRn
-> LFieldOcc GhcRn
-> ReaderT MetaWrappers DsM (Core (M VarBangType))
rep_one_ip LHsType GhcRn
t LFieldOcc GhcRn
n = do { MkC CoreExpr
v  <- Name -> MetaM (Core Name)
lookupOcc (FieldOcc GhcRn -> XCFieldOcc GhcRn
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc (FieldOcc GhcRn -> XCFieldOcc GhcRn)
-> FieldOcc GhcRn -> XCFieldOcc GhcRn
forall a b. (a -> b) -> a -> b
$ LFieldOcc GhcRn -> FieldOcc GhcRn
forall l e. GenLocated l e -> e
unLoc LFieldOcc GhcRn
n)
                          ; MkC CoreExpr
ty <- LHsType GhcRn -> MetaM (Core (M BangType))
repBangTy  LHsType GhcRn
t
                          ; Name
-> [CoreExpr] -> ReaderT MetaWrappers DsM (Core (M VarBangType))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
varBangTypeName [CoreExpr
v,CoreExpr
ty] }

repConstr (InfixCon HsScaled GhcRn (LHsType GhcRn)
st1 HsScaled GhcRn (LHsType GhcRn)
st2) Maybe (LHsType GhcRn)
Nothing [Core Name
con]
    = do Core (M BangType)
arg1 <- LHsType GhcRn -> MetaM (Core (M BangType))
repBangTy (HsScaled GhcRn (LHsType GhcRn) -> LHsType GhcRn
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled GhcRn (LHsType GhcRn)
st1)
         Core (M BangType)
arg2 <- LHsType GhcRn -> MetaM (Core (M BangType))
repBangTy (HsScaled GhcRn (LHsType GhcRn) -> LHsType GhcRn
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled GhcRn (LHsType GhcRn)
st2)
         Name -> [CoreExpr] -> MetaM (Core (M Con))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixCName [Core (M BangType) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M BangType)
arg1, Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC Core Name
con, Core (M BangType) -> CoreExpr
forall a. Core a -> CoreExpr
unC Core (M BangType)
arg2]

repConstr (InfixCon {}) (Just LHsType GhcRn
_) [Core Name]
_ =
    String -> MetaM (Core (M Con))
forall a. String -> a
panic String
"repConstr: infix GADT constructor should be in a PrefixCon"
repConstr HsConDeclDetails GhcRn
_ Maybe (LHsType GhcRn)
_ [Core Name]
_ =
    String -> MetaM (Core (M Con))
forall a. String -> a
panic String
"repConstr: invariant violated"

------------ 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 a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forallTName [CoreExpr
tvars, CoreExpr
ctxt, CoreExpr
ty]

repTForallVis :: Core [(M (TH.TyVarBndr ()))] -> Core (M TH.Type)
              -> MetaM (Core (M TH.Type))
repTForallVis :: Core [M (TyVarBndr ())] -> Core (M Type) -> MetaM (Core (M Type))
repTForallVis (MkC CoreExpr
tvars) (MkC CoreExpr
ty) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
forallVisTName [CoreExpr
tvars, CoreExpr
ty]

repTvar :: Core TH.Name -> MetaM (Core (M TH.Type))
repTvar :: Core Name -> MetaM (Core (M Type))
repTvar (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
varTName [CoreExpr
s]

repTapp :: Core (M TH.Type) -> Core (M TH.Type) -> MetaM (Core (M TH.Type))
repTapp :: Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp (MkC CoreExpr
t1) (MkC CoreExpr
t2) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
appTName [CoreExpr
t1, CoreExpr
t2]

repTappKind :: Core (M TH.Type) -> Core (M TH.Kind) -> MetaM (Core (M TH.Type))
repTappKind :: Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTappKind (MkC CoreExpr
ty) (MkC CoreExpr
ki) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
appKindTName [CoreExpr
ty,CoreExpr
ki]

repTapps :: Core (M TH.Type) -> [Core (M TH.Type)] -> MetaM (Core (M TH.Type))
repTapps :: Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
f []     = Core (M Type) -> MetaM (Core (M Type))
forall (m :: * -> *) a. Monad m => a -> m a
return Core (M Type)
f
repTapps Core (M Type)
f (Core (M Type)
t:[Core (M Type)]
ts) = do { Core (M Type)
f1 <- Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
f Core (M Type)
t; Core (M Type) -> [Core (M Type)] -> MetaM (Core (M Type))
repTapps Core (M Type)
f1 [Core (M Type)]
ts }

repTSig :: Core (M TH.Type) -> Core (M TH.Kind) -> MetaM (Core (M TH.Type))
repTSig :: Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTSig (MkC CoreExpr
ty) (MkC CoreExpr
ki) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
sigTName [CoreExpr
ty, CoreExpr
ki]

repTequality :: MetaM (Core (M TH.Type))
repTequality :: MetaM (Core (M Type))
repTequality = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
equalityTName []

repTPromotedList :: [Core (M TH.Type)] -> MetaM (Core (M TH.Type))
repTPromotedList :: [Core (M Type)] -> MetaM (Core (M Type))
repTPromotedList []     = MetaM (Core (M Type))
repPromotedNilTyCon
repTPromotedList (Core (M Type)
t:[Core (M Type)]
ts) = do  { Core (M Type)
tcon <- MetaM (Core (M Type))
repPromotedConsTyCon
                              ; Core (M Type)
f <- Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
tcon Core (M Type)
t
                              ; Core (M Type)
t' <- [Core (M Type)] -> MetaM (Core (M Type))
repTPromotedList [Core (M Type)]
ts
                              ; Core (M Type) -> Core (M Type) -> MetaM (Core (M Type))
repTapp Core (M Type)
f Core (M Type)
t'
                              }

repTLit :: Core (M TH.TyLit) -> MetaM (Core (M TH.Type))
repTLit :: Core (M TyLit) -> MetaM (Core (M Type))
repTLit (MkC CoreExpr
lit) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
litTName [CoreExpr
lit]

repTWildCard :: MetaM (Core (M TH.Type))
repTWildCard :: MetaM (Core (M Type))
repTWildCard = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
wildCardTName []

repTImplicitParam :: Core String -> Core (M TH.Type) -> MetaM (Core (M TH.Type))
repTImplicitParam :: Core String -> Core (M Type) -> MetaM (Core (M Type))
repTImplicitParam (MkC CoreExpr
n) (MkC CoreExpr
e) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
implicitParamTName [CoreExpr
n, CoreExpr
e]

repTStar :: MetaM (Core (M TH.Type))
repTStar :: MetaM (Core (M Type))
repTStar = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
starKName []

repTConstraint :: MetaM (Core (M TH.Type))
repTConstraint :: MetaM (Core (M Type))
repTConstraint = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
constraintKName []

--------- 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 a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
conTName [CoreExpr
s]

repTInfix :: Core (M TH.Type) -> Core TH.Name -> Core (M TH.Type)
             -> MetaM (Core (M TH.Type))
repTInfix :: Core (M Type)
-> Core Name -> Core (M Type) -> MetaM (Core (M Type))
repTInfix (MkC CoreExpr
t1) (MkC CoreExpr
name) (MkC CoreExpr
t2) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
infixTName [CoreExpr
t1,CoreExpr
name,CoreExpr
t2]

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

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

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

repArrowTyCon :: MetaM (Core (M TH.Type))
repArrowTyCon :: MetaM (Core (M Type))
repArrowTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
arrowTName []

repMulArrowTyCon :: MetaM (Core (M TH.Type))
repMulArrowTyCon :: MetaM (Core (M Type))
repMulArrowTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
mulArrowTName []

repListTyCon :: MetaM (Core (M TH.Type))
repListTyCon :: MetaM (Core (M Type))
repListTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
listTName []

repPromotedDataCon :: Core TH.Name -> MetaM (Core (M TH.Type))
repPromotedDataCon :: Core Name -> MetaM (Core (M Type))
repPromotedDataCon (MkC CoreExpr
s) = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
promotedTName [CoreExpr
s]

repPromotedTupleTyCon :: Int -> MetaM (Core (M TH.Type))
repPromotedTupleTyCon :: Int -> MetaM (Core (M Type))
repPromotedTupleTyCon Int
i = do Platform
platform <- MetaM Platform
getPlatform
                             Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
promotedTupleTName [Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
i]

repPromotedNilTyCon :: MetaM (Core (M TH.Type))
repPromotedNilTyCon :: MetaM (Core (M Type))
repPromotedNilTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
promotedNilTName []

repPromotedConsTyCon :: MetaM (Core (M TH.Type))
repPromotedConsTyCon :: MetaM (Core (M Type))
repPromotedConsTyCon = Name -> [CoreExpr] -> MetaM (Core (M Type))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
promotedConsTName []

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

repNoSig :: MetaM (Core (M TH.FamilyResultSig))
repNoSig :: MetaM (Core (M FamilyResultSig))
repNoSig = Name -> [CoreExpr] -> MetaM (Core (M FamilyResultSig))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
noSigName []

repKindSig :: Core (M TH.Kind) -> MetaM (Core (M TH.FamilyResultSig))
repKindSig :: Core (M Type) -> MetaM (Core (M FamilyResultSig))
repKindSig (MkC CoreExpr
ki) = Name -> [CoreExpr] -> MetaM (Core (M FamilyResultSig))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
kindSigName [CoreExpr
ki]

repTyVarSig :: Core (M (TH.TyVarBndr ())) -> MetaM (Core (M TH.FamilyResultSig))
repTyVarSig :: Core (M (TyVarBndr ())) -> MetaM (Core (M FamilyResultSig))
repTyVarSig (MkC CoreExpr
bndr) = Name -> [CoreExpr] -> MetaM (Core (M FamilyResultSig))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
tyVarSigName [CoreExpr
bndr]

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

repLiteral :: HsLit GhcRn -> MetaM (Core TH.Lit)
repLiteral :: HsLit GhcRn -> MetaM (Core Lit)
repLiteral (HsStringPrim XHsStringPrim GhcRn
_ ByteString
bs)
  = do Platform
platform <- MetaM Platform
getPlatform
       Type
word8_ty <- Name -> MetaM Type
lookupType Name
word8TyConName
       let w8s :: [Word8]
w8s = ByteString -> [Word8]
unpack ByteString
bs
           w8s_expr :: [CoreExpr]
w8s_expr = (Word8 -> CoreExpr) -> [Word8] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (\Word8
w8 -> DataCon -> [CoreExpr] -> CoreExpr
mkCoreConApps DataCon
word8DataCon
                                  [Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkWordLit Platform
platform (Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
w8)]) [Word8]
w8s
       Name -> [CoreExpr] -> MetaM (Core Lit)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
stringPrimLName [Type -> [CoreExpr] -> CoreExpr
mkListExpr Type
word8_ty [CoreExpr]
w8s_expr]
repLiteral HsLit GhcRn
lit
  = do HsLit GhcRn
lit' <- case HsLit GhcRn
lit of
                   HsIntPrim XHsIntPrim GhcRn
_ Integer
i    -> Integer -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_integer Integer
i
                   HsWordPrim XHsWordPrim GhcRn
_ Integer
w   -> Integer -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_integer Integer
w
                   HsInt XHsInt GhcRn
_ IntegralLit
i        -> Integer -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_integer (IntegralLit -> Integer
il_value IntegralLit
i)
                   HsFloatPrim XHsFloatPrim GhcRn
_ FractionalLit
r  -> FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_rational FractionalLit
r
                   HsDoublePrim XHsDoublePrim GhcRn
_ FractionalLit
r -> FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_rational FractionalLit
r
                   HsCharPrim XHsCharPrim GhcRn
_ Char
c   -> Char -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_char Char
c
                   HsLit GhcRn
_ -> HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return HsLit GhcRn
lit
       CoreExpr
lit_expr <- DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr)
-> DsM CoreExpr -> ReaderT MetaWrappers DsM CoreExpr
forall a b. (a -> b) -> a -> b
$ HsLit GhcRn -> DsM CoreExpr
dsLit HsLit GhcRn
lit'
       case Maybe Name
mb_lit_name of
          Just Name
lit_name -> Name -> [CoreExpr] -> MetaM (Core Lit)
forall a. NotM a => Name -> [CoreExpr] -> MetaM (Core a)
rep2_nw Name
lit_name [CoreExpr
lit_expr]
          Maybe Name
Nothing -> String -> SDoc -> MetaM (Core Lit)
forall a. String -> SDoc -> MetaM a
notHandled String
"Exotic literal" (HsLit GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLit GhcRn
lit)
  where
    mb_lit_name :: Maybe Name
mb_lit_name = case HsLit GhcRn
lit of
                 HsInteger XHsInteger GhcRn
_ Integer
_ Type
_  -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
integerLName
                 HsInt XHsInt GhcRn
_ IntegralLit
_        -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
integerLName
                 HsIntPrim XHsIntPrim GhcRn
_ Integer
_    -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
intPrimLName
                 HsWordPrim XHsWordPrim GhcRn
_ Integer
_   -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
wordPrimLName
                 HsFloatPrim XHsFloatPrim GhcRn
_ FractionalLit
_  -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
floatPrimLName
                 HsDoublePrim XHsDoublePrim GhcRn
_ FractionalLit
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
doublePrimLName
                 HsChar XHsChar GhcRn
_ Char
_       -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
charLName
                 HsCharPrim XHsCharPrim GhcRn
_ Char
_   -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
charPrimLName
                 HsString XHsString GhcRn
_ CLabelString
_     -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
stringLName
                 HsRat XHsRat GhcRn
_ FractionalLit
_ Type
_      -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
rationalLName
                 HsLit GhcRn
_                -> Maybe Name
forall a. Maybe a
Nothing

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

mk_rational :: FractionalLit -> MetaM (HsLit GhcRn)
mk_rational :: FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_rational FractionalLit
r = do Type
rat_ty <- Name -> MetaM Type
lookupType Name
rationalTyConName
                   HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn))
-> HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a b. (a -> b) -> a -> b
$ XHsRat GhcRn -> FractionalLit -> Type -> HsLit GhcRn
forall x. XHsRat x -> FractionalLit -> Type -> HsLit x
HsRat NoExtField
XHsRat GhcRn
noExtField FractionalLit
r Type
rat_ty
mk_string :: FastString -> MetaM (HsLit GhcRn)
mk_string :: CLabelString -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_string CLabelString
s = HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn))
-> HsLit GhcRn -> ReaderT MetaWrappers DsM (HsLit GhcRn)
forall a b. (a -> b) -> a -> b
$ XHsString GhcRn -> CLabelString -> HsLit GhcRn
forall x. XHsString x -> CLabelString -> HsLit x
HsString SourceText
XHsString GhcRn
NoSourceText CLabelString
s

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

repOverloadedLiteral :: HsOverLit GhcRn -> MetaM (Core TH.Lit)
repOverloadedLiteral :: HsOverLit GhcRn -> MetaM (Core Lit)
repOverloadedLiteral (OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = OverLitVal
val})
  = do { HsLit GhcRn
lit <- OverLitVal -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_lit OverLitVal
val; HsLit GhcRn -> MetaM (Core Lit)
repLiteral HsLit GhcRn
lit }
        -- 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

mk_lit :: OverLitVal -> MetaM (HsLit GhcRn)
mk_lit :: OverLitVal -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_lit (HsIntegral IntegralLit
i)     = Integer -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_integer  (IntegralLit -> Integer
il_value IntegralLit
i)
mk_lit (HsFractional FractionalLit
f)   = FractionalLit -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_rational FractionalLit
f
mk_lit (HsIsString SourceText
_ CLabelString
s)   = CLabelString -> ReaderT MetaWrappers DsM (HsLit GhcRn)
mk_string   CLabelString
s

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]

--------------- 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 a. 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 a b.
Type -> Type -> Core (M a) -> Core (a -> M b) -> MetaM (Core (M b))
repBindM Type
ty_a Type
ty_b (MkC CoreExpr
x) (MkC CoreExpr
y)
  = Name -> [CoreExpr] -> MetaM (Core (M b))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2M Name
bindMName [Type -> CoreExpr
forall b. Type -> Expr b
Type Type
ty_a, Type -> CoreExpr
forall b. Type -> Expr b
Type Type
ty_b, CoreExpr
x, CoreExpr
y]

repSequenceM :: Type -> Core [M a] -> MetaM (Core (M [a]))
repSequenceM :: forall a. Type -> Core [M a] -> MetaM (Core (M [a]))
repSequenceM Type
ty_a (MkC CoreExpr
list)
  = Name -> [CoreExpr] -> MetaM (Core (M [a]))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2M Name
sequenceQName [Type -> CoreExpr
forall b. Type -> Expr b
Type Type
ty_a, CoreExpr
list]

repUnboundVar :: Core TH.Name -> MetaM (Core (M TH.Exp))
repUnboundVar :: Core Name -> MetaM (Core (M Exp))
repUnboundVar (MkC CoreExpr
name) = Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
unboundVarEName [CoreExpr
name]

repOverLabel :: FastString -> MetaM (Core (M TH.Exp))
repOverLabel :: CLabelString -> MetaM (Core (M Exp))
repOverLabel CLabelString
fs = do
                    (MkC CoreExpr
s) <- String -> ReaderT MetaWrappers DsM (Core String)
forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit (String -> ReaderT MetaWrappers DsM (Core String))
-> String -> ReaderT MetaWrappers DsM (Core String)
forall a b. (a -> b) -> a -> b
$ CLabelString -> String
unpackFS CLabelString
fs
                    Name -> [CoreExpr] -> MetaM (Core (M Exp))
forall a. Name -> [CoreExpr] -> MetaM (Core (M a))
rep2 Name
labelEName [CoreExpr
s]


------------ 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 { [Core b]
args1 <- (a -> MetaM (Core b)) -> [a] -> ReaderT MetaWrappers DsM [Core b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> MetaM (Core b)
f [a]
args
       ; Name -> [Core b] -> MetaM (Core [b])
forall a. Name -> [Core a] -> MetaM (Core [a])
coreList Name
tc_name [Core b]
args1 }

-- 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 { Type
ty <- Name -> MetaM Type
wrapName Name
tc_name
       ; [Core b]
args1 <- (a -> MetaM (Core b)) -> [a] -> ReaderT MetaWrappers DsM [Core b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> MetaM (Core b)
f [a]
args
       ; Core [b] -> MetaM (Core [b])
forall (m :: * -> *) a. Monad m => a -> m a
return (Core [b] -> MetaM (Core [b])) -> Core [b] -> MetaM (Core [b])
forall a b. (a -> b) -> a -> b
$ Type -> [Core b] -> Core [b]
forall a. Type -> [Core a] -> Core [a]
coreList' Type
ty [Core b]
args1 }

coreListM :: Name -> [Core a] -> MetaM (Core [a])
coreListM :: forall a. Name -> [Core a] -> MetaM (Core [a])
coreListM Name
tc [Core a]
as = Name -> (Core a -> MetaM (Core a)) -> [Core a] -> MetaM (Core [a])
forall a b.
Name -> (a -> MetaM (Core b)) -> [a] -> MetaM (Core [b])
repListM Name
tc Core a -> MetaM (Core a)
forall (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 { Type
elt_ty <- Name -> MetaM Type
lookupType Name
tc_name; Core [a] -> MetaM (Core [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> [Core a] -> Core [a]
forall a. Type -> [Core a] -> Core [a]
coreList' Type
elt_ty [Core a]
es) }

coreList' :: Type       -- 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 a. CoreExpr -> Core a
MkC (Type -> [CoreExpr] -> CoreExpr
mkListExpr Type
elt_ty ((Core a -> CoreExpr) -> [Core a] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map Core a -> CoreExpr
forall a. Core a -> CoreExpr
unC [Core a]
es ))

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. String -> a
panic String
"coreList: empty argument"
nonEmptyCoreList xs :: [Core a]
xs@(MkC CoreExpr
x:[Core a]
_) = CoreExpr -> Core [a]
forall a. CoreExpr -> Core a
MkC (Type -> [CoreExpr] -> CoreExpr
mkListExpr (CoreExpr -> Type
exprType CoreExpr
x) ((Core a -> CoreExpr) -> [Core a] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map Core a -> CoreExpr
forall a. Core a -> CoreExpr
unC [Core a]
xs))


coreStringLit :: MonadThings m => String -> m (Core String)
coreStringLit :: forall (m :: * -> *). MonadThings m => String -> m (Core String)
coreStringLit String
s = do { CoreExpr
z <- String -> m CoreExpr
forall (m :: * -> *). MonadThings m => String -> m CoreExpr
mkStringExpr String
s; Core String -> m (Core String)
forall (m :: * -> *) a. Monad m => a -> m a
return(CoreExpr -> Core String
forall a. CoreExpr -> Core a
MkC CoreExpr
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
  Type
t <- Name -> MetaM Type
lookupType Name
tc_name
  Type -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
forall a b.
Type -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
repMaybeT Type
t a -> MetaM (Core b)
f Maybe a
m

repMaybeT :: Type -> (a -> MetaM (Core b))
                    -> Maybe a -> MetaM (Core (Maybe b))
repMaybeT :: forall a b.
Type -> (a -> MetaM (Core b)) -> Maybe a -> MetaM (Core (Maybe b))
repMaybeT Type
ty a -> MetaM (Core b)
_ Maybe a
Nothing   = Core (Maybe b) -> ReaderT MetaWrappers DsM (Core (Maybe b))
forall (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 { Type
elt_ty <- Name -> MetaM Type
lookupType Name
tc_name; Core (Maybe a) -> MetaM (Core (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Core (Maybe a)
forall a. Type -> Core (Maybe a)
coreNothing' Type
elt_ty) }

coreNothingM :: Name -> MetaM (Core (Maybe a))
coreNothingM :: forall a. Name -> MetaM (Core (Maybe a))
coreNothingM Name
tc_name =
    do { Type
elt_ty <- Name -> MetaM Type
wrapName Name
tc_name; Core (Maybe a) -> MetaM (Core (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Core (Maybe a)
forall a. Type -> Core (Maybe a)
coreNothing' Type
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 a. 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 { Type
elt_ty <- Name -> MetaM Type
lookupType Name
tc_name; Core (Maybe a) -> MetaM (Core (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Core a -> Core (Maybe a)
forall a. Type -> Core a -> Core (Maybe a)
coreJust' Type
elt_ty Core a
es) }

coreJustM :: Name -> Core a -> MetaM (Core (Maybe a))
coreJustM :: forall a. Name -> Core a -> MetaM (Core (Maybe a))
coreJustM Name
tc_name Core a
es = do { Type
elt_ty <- Name -> MetaM Type
wrapName Name
tc_name; Core (Maybe a) -> MetaM (Core (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Core a -> Core (Maybe a)
forall a. Type -> Core a -> Core (Maybe a)
coreJust' Type
elt_ty Core a
es) }

-- | 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 a. CoreExpr -> Core a
MkC (Type -> CoreExpr -> CoreExpr
mkJustExpr Type
elt_ty (Core a -> CoreExpr
forall a. Core a -> CoreExpr
unC Core a
es))

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

-- Lookup the name and wrap it with the m variable
repMaybeListM :: Name -> (a -> MetaM (Core b))
                        -> Maybe [a] -> MetaM (Core (Maybe [b]))
repMaybeListM :: forall a b.
Name
-> (a -> MetaM (Core b)) -> Maybe [a] -> MetaM (Core (Maybe [b]))
repMaybeListM Name
tc_name a -> MetaM (Core b)
f Maybe [a]
xs = do
  Type
elt_ty <- Name -> MetaM Type
wrapName Name
tc_name
  Type
-> (a -> MetaM (Core b)) -> Maybe [a] -> MetaM (Core (Maybe [b]))
forall a b.
Type
-> (a -> MetaM (Core b)) -> Maybe [a] -> MetaM (Core (Maybe [b]))
repMaybeListT Type
elt_ty a -> MetaM (Core b)
f Maybe [a]
xs


repMaybeListT :: Type -> (a -> MetaM (Core b))
                        -> Maybe [a] -> MetaM (Core (Maybe [b]))
repMaybeListT :: forall a b.
Type
-> (a -> MetaM (Core b)) -> Maybe [a] -> MetaM (Core (Maybe [b]))
repMaybeListT Type
elt_ty a -> MetaM (Core b)
_ Maybe [a]
Nothing = Type -> MetaM (Core (Maybe [b]))
forall a. Type -> MetaM (Core (Maybe [a]))
coreNothingList Type
elt_ty
repMaybeListT Type
elt_ty a -> MetaM (Core b)
f (Just [a]
args)
  = do { [Core b]
args1 <- (a -> MetaM (Core b)) -> [a] -> ReaderT MetaWrappers DsM [Core b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> MetaM (Core b)
f [a]
args
       ; Core (Maybe [b]) -> MetaM (Core (Maybe [b]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Core (Maybe [b]) -> MetaM (Core (Maybe [b])))
-> Core (Maybe [b]) -> MetaM (Core (Maybe [b]))
forall a b. (a -> b) -> a -> b
$ Type -> Core [b] -> Core (Maybe [b])
forall a. Type -> Core a -> Core (Maybe a)
coreJust' (Type -> Type
mkListTy Type
elt_ty) (Type -> [Core b] -> Core [b]
forall a. Type -> [Core a] -> Core [a]
coreList' Type
elt_ty [Core b]
args1) }

coreNothingList :: Type -> MetaM (Core (Maybe [a]))
coreNothingList :: forall a. Type -> MetaM (Core (Maybe [a]))
coreNothingList Type
elt_ty = Core (Maybe [a]) -> ReaderT MetaWrappers DsM (Core (Maybe [a]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Core (Maybe [a]) -> ReaderT MetaWrappers DsM (Core (Maybe [a])))
-> Core (Maybe [a]) -> ReaderT MetaWrappers DsM (Core (Maybe [a]))
forall a b. (a -> b) -> a -> b
$ 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
platform <- MetaM Platform
getPlatform
                  Core Int -> MetaM (Core Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core Int
forall a. CoreExpr -> Core a
MkC (Platform -> Int -> CoreExpr
mkIntExprInt Platform
platform Int
i))

coreIntegerLit :: MonadThings m => Integer -> m (Core Integer)
coreIntegerLit :: forall (m :: * -> *). MonadThings m => Integer -> m (Core Integer)
coreIntegerLit Integer
i = Core Integer -> m (Core Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> Core Integer
forall a. CoreExpr -> Core a
MkC (Integer -> CoreExpr
mkIntegerExpr Integer
i))

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

----------------- Failure -----------------------
notHandledL :: SrcSpan -> String -> SDoc -> MetaM a
notHandledL :: forall a. SrcSpan -> String -> SDoc -> MetaM a
notHandledL SrcSpan
loc String
what SDoc
doc
  | 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
$ String -> SDoc -> ReaderT MetaWrappers DsM a
forall a. String -> SDoc -> MetaM a
notHandled String
what SDoc
doc
  | Bool
otherwise
  = String -> SDoc -> ReaderT MetaWrappers DsM a
forall a. String -> SDoc -> MetaM a
notHandled String
what SDoc
doc

notHandled :: String -> SDoc -> MetaM a
notHandled :: forall a. String -> SDoc -> MetaM a
notHandled String
what SDoc
doc = IOEnv (Env DsGblEnv DsLclEnv) a -> ReaderT MetaWrappers DsM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv (Env DsGblEnv DsLclEnv) a -> ReaderT MetaWrappers DsM a)
-> IOEnv (Env DsGblEnv DsLclEnv) a -> ReaderT MetaWrappers DsM a
forall a b. (a -> b) -> a -> b
$ SDoc -> IOEnv (Env DsGblEnv DsLclEnv) a
forall a. SDoc -> DsM a
failWithDs SDoc
msg
  where
    msg :: SDoc
msg = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"not (yet) handled by Template Haskell")
             Int
2 SDoc
doc