{-# LANGUAGE CPP, TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}

-----------------------------------------------------------------------------
--
-- (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/PrelNames.  It's much more convenient to do it here, because
-- otherwise we have to recompile PrelNames whenever we add a Name, which is
-- a Royal Pain (triggers other recompilation).
-----------------------------------------------------------------------------

module DsMeta( dsBracket ) where

#include "HsVersions.h"

import GhcPrelude

import {-# SOURCE #-}   DsExpr ( dsExpr )

import MatchLit
import DsMonad

import qualified Language.Haskell.TH as TH

import GHC.Hs
import PrelNames
-- To avoid clashes with DsMeta.varName we must make a local alias for
-- OccName.varName we do this by removing varName from the import of
-- OccName above, making a qualified instance of OccName and using
-- OccNameAlias.varName where varName ws previously used in this file.
import qualified OccName( isDataOcc, isVarOcc, isTcOcc )

import Module
import Id
import Name hiding( isVarOcc, isTcOcc, varName, tcName )
import THNames
import NameEnv
import TcType
import TyCon
import TysWiredIn
import CoreSyn
import MkCore
import CoreUtils
import SrcLoc
import Unique
import BasicTypes
import Outputable
import Bag
import DynFlags
import FastString
import ForeignCall
import Util
import Maybes
import MonadUtils

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

-----------------------------------------------------------------------------
dsBracket :: HsBracket GhcRn -> [PendingTcSplice] -> DsM CoreExpr
-- Returns a CoreExpr of type TH.ExpQ
-- The quoted thing is parameterised over Name, even though it has
-- been type checked.  We don't want all those type decorations!

dsBracket :: HsBracket GhcRn -> [PendingTcSplice] -> DsM CoreExpr
dsBracket HsBracket GhcRn
brack [PendingTcSplice]
splices
  = DsMetaEnv -> DsM CoreExpr -> DsM CoreExpr
forall a. DsMetaEnv -> DsM a -> DsM a
dsExtendMetaEnv DsMetaEnv
new_bit (HsBracket GhcRn -> DsM CoreExpr
do_brack HsBracket GhcRn
brack)
  where
    new_bit :: DsMetaEnv
new_bit = [(Name, DsMetaVal)] -> DsMetaEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name
n, HsExpr GhcTc -> DsMetaVal
DsSplice (LHsExpr GhcTc -> SrcSpanLess (LHsExpr GhcTc)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcTc
e))
                        | PendingTcSplice Name
n LHsExpr 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)
lookupOcc 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)   = do { MkC CoreExpr
e1  <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e     ; CoreExpr -> DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1 }
    do_brack (PatBr XPatBr GhcRn
_ LPat GhcRn
p)   = do { MkC CoreExpr
p1  <- LPat GhcRn -> DsM (Core PatQ)
repTopP LPat GhcRn
p   ; CoreExpr -> DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
p1 }
    do_brack (TypBr XTypBr GhcRn
_ LHsType GhcRn
t)   = do { MkC CoreExpr
t1  <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
t    ; CoreExpr -> DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
t1 }
    do_brack (DecBrG XDecBrG GhcRn
_ HsGroup GhcRn
gp) = do { MkC CoreExpr
ds1 <- HsGroup GhcRn -> DsM (Core (Q [Dec]))
repTopDs HsGroup GhcRn
gp ; CoreExpr -> 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)  = do { MkC CoreExpr
e1  <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e     ; CoreExpr -> DsM CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
e1 }
    do_brack (XBracket XXBracket GhcRn
nec) = NoExtCon -> DsM CoreExpr
forall a. NoExtCon -> a
noExtCon XXBracket GhcRn
NoExtCon
nec

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

repTopP :: LPat GhcRn -> DsM (Core TH.PatQ)
repTopP :: LPat GhcRn -> DsM (Core PatQ)
repTopP LPat GhcRn
pat = do { [GenSymBind]
ss <- [Name] -> DsM [GenSymBind]
mkGenSyms (LPat GhcRn -> [IdP GhcRn]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat GhcRn
pat)
                 ; Core PatQ
pat' <- [GenSymBind] -> DsM (Core PatQ) -> DsM (Core PatQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss (LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
pat)
                 ; [GenSymBind] -> Core PatQ -> DsM (Core PatQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core PatQ
pat' }

repTopDs :: HsGroup GhcRn -> DsM (Core (TH.Q [TH.Dec]))
repTopDs :: HsGroup GhcRn -> DsM (Core (Q [Dec]))
repTopDs group :: HsGroup GhcRn
group@(HsGroup { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds   = HsValBinds GhcRn
valds
                        , hs_splcds :: forall p. HsGroup p -> [LSpliceDecl p]
hs_splcds  = [LSpliceDecl GhcRn]
splcds
                        , hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds  = [TyClGroup GhcRn]
tyclds
                        , hs_derivds :: forall p. HsGroup p -> [LDerivDecl p]
hs_derivds = [LDerivDecl GhcRn]
derivds
                        , hs_fixds :: forall p. HsGroup p -> [LFixitySig p]
hs_fixds   = [LFixitySig GhcRn]
fixds
                        , hs_defds :: forall p. HsGroup p -> [LDefaultDecl p]
hs_defds   = [LDefaultDecl GhcRn]
defds
                        , hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
hs_fords   = [LForeignDecl GhcRn]
fords
                        , hs_warnds :: forall p. HsGroup p -> [LWarnDecls p]
hs_warnds  = [LWarnDecls GhcRn]
warnds
                        , hs_annds :: forall p. HsGroup p -> [LAnnDecl p]
hs_annds   = [LAnnDecl GhcRn]
annds
                        , hs_ruleds :: forall p. HsGroup p -> [LRuleDecls p]
hs_ruleds  = [LRuleDecls GhcRn]
ruleds
                        , hs_docs :: forall p. HsGroup p -> [LDocDecl]
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] -> DsM [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 DecQ]
decls <- [GenSymBind] -> DsM [Core DecQ] -> DsM [Core DecQ]
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss (
                  do { [(SrcSpan, Core DecQ)]
val_ds   <- HsValBinds GhcRn -> DsM [(SrcSpan, Core DecQ)]
rep_val_binds HsValBinds GhcRn
valds
                     ; [Any]
_        <- (LSpliceDecl GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) Any)
-> [LSpliceDecl GhcRn] -> IOEnv (Env DsGblEnv DsLclEnv) [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LSpliceDecl GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) Any
forall a a. HasSrcSpan a => a -> DsM a
no_splice [LSpliceDecl GhcRn]
splcds
                     ; [Maybe (SrcSpan, Core DecQ)]
tycl_ds  <- (LTyClDecl GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ)))
-> [LTyClDecl GhcRn]
-> IOEnv (Env DsGblEnv DsLclEnv) [Maybe (SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LTyClDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ))
repTyClD ([TyClGroup GhcRn] -> [LTyClDecl GhcRn]
forall pass. [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls [TyClGroup GhcRn]
tyclds)
                     ; [(SrcSpan, Core DecQ)]
role_ds  <- (LRoleAnnotDecl GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LRoleAnnotDecl GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LRoleAnnotDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
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 DecQ)]
kisig_ds <- (LStandaloneKindSig GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LStandaloneKindSig GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LStandaloneKindSig GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
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 DecQ)]
inst_ds  <- (LInstDecl GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LInstDecl GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LInstDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repInstD [LInstDecl GhcRn]
instds
                     ; [(SrcSpan, Core DecQ)]
deriv_ds <- (LDerivDecl GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LDerivDecl GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LDerivDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repStandaloneDerivD [LDerivDecl GhcRn]
derivds
                     ; [[(SrcSpan, Core DecQ)]]
fix_ds   <- (LFixitySig GhcRn -> DsM [(SrcSpan, Core DecQ)])
-> [LFixitySig GhcRn]
-> IOEnv (Env DsGblEnv DsLclEnv) [[(SrcSpan, Core DecQ)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LFixitySig GhcRn -> DsM [(SrcSpan, Core DecQ)]
repFixD [LFixitySig GhcRn]
fixds
                     ; [Any]
_        <- (LDefaultDecl GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) Any)
-> [LDefaultDecl GhcRn] -> IOEnv (Env DsGblEnv DsLclEnv) [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LDefaultDecl GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) Any
forall a a.
(HasSrcSpan a, Outputable (SrcSpanLess a)) =>
a -> DsM a
no_default_decl [LDefaultDecl GhcRn]
defds
                     ; [(SrcSpan, Core DecQ)]
for_ds   <- (LForeignDecl GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LForeignDecl GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LForeignDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repForD [LForeignDecl GhcRn]
fords
                     ; [Any]
_        <- (LWarnDecl GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) Any)
-> [LWarnDecl GhcRn] -> IOEnv (Env DsGblEnv DsLclEnv) [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LWarnDecl GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) Any
forall a pass a.
(HasSrcSpan a, Outputable (IdP pass),
 SrcSpanLess a ~ WarnDecl pass) =>
a -> DsM 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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
                                                           [LWarnDecls GhcRn]
warnds)
                     ; [(SrcSpan, Core DecQ)]
ann_ds   <- (LAnnDecl GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LAnnDecl GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LAnnDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repAnnD [LAnnDecl GhcRn]
annds
                     ; [(SrcSpan, Core DecQ)]
rule_ds  <- (LRuleDecl GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LRuleDecl GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LRuleDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
                                                            [LRuleDecls GhcRn]
ruleds)
                     ; [Any]
_        <- (LDocDecl -> IOEnv (Env DsGblEnv DsLclEnv) Any)
-> [LDocDecl] -> IOEnv (Env DsGblEnv DsLclEnv) [Any]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LDocDecl -> IOEnv (Env DsGblEnv DsLclEnv) Any
forall a a. HasSrcSpan a => a -> DsM a
no_doc [LDocDecl]
docs

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

        Type
decl_ty <- Name -> DsM Type
lookupType Name
decQTyConName ;
        let { core_list :: Core [DecQ]
core_list = Type -> [Core DecQ] -> Core [DecQ]
forall a. Type -> [Core a] -> Core [a]
coreList' Type
decl_ty [Core DecQ]
decls } ;

        Type
dec_ty <- Name -> DsM Type
lookupType Name
decTyConName ;
        Core (Q [Dec])
q_decs  <- Type -> Core [DecQ] -> DsM (Core (Q [Dec]))
forall a. Type -> Core [Q a] -> DsM (Core (Q [a]))
repSequenceQ Type
dec_ty Core [DecQ]
core_list ;

        [GenSymBind] -> Core (Q [Dec]) -> DsM (Core (Q [Dec]))
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core (Q [Dec])
q_decs
      }
  where
    no_splice :: a -> DsM a
no_splice (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess a
_)
      = SrcSpan -> String -> SDoc -> DsM a
forall a. SrcSpan -> String -> SDoc -> DsM a
notHandledL SrcSpan
loc String
"Splices within declaration brackets" SDoc
empty
    no_default_decl :: a -> DsM a
no_default_decl (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess a
decl)
      = SrcSpan -> String -> SDoc -> DsM a
forall a. SrcSpan -> String -> SDoc -> DsM a
notHandledL SrcSpan
loc String
"Default declarations" (SrcSpanLess a -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpanLess a
decl)
    no_warn :: a -> DsM a
no_warn (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (Warning _ thing _))
      = SrcSpan -> String -> SDoc -> DsM a
forall a. SrcSpan -> String -> SDoc -> DsM a
notHandledL SrcSpan
loc String
"WARNING and DEPRECATION pragmas" (SDoc -> DsM a) -> SDoc -> DsM a
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
text String
"Pragma for declaration of" SDoc -> SDoc -> SDoc
<+> [Located (IdP pass)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Located (IdP pass)]
thing
    no_warn a
_ = String -> DsM a
forall a. String -> a
panic String
"repTopDs"
    no_doc :: a -> DsM a
no_doc (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess a
_)
      = SrcSpan -> String -> SDoc -> DsM a
forall a. SrcSpan -> String -> SDoc -> DsM a
notHandledL SrcSpan
loc String
"Haddock documentation" SDoc
empty
repTopDs (XHsGroup XXHsGroup GhcRn
nec) = NoExtCon -> DsM (Core (Q [Dec]))
forall a. NoExtCon -> a
noExtCon XXHsGroup GhcRn
NoExtCon
nec

hsScopedTvBinders :: HsValBinds GhcRn -> [Name]
-- See Note [Scoped type variables in bindings]
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 _ sigs) -> [LSig GhcRn]
sigs

get_scoped_tvs :: LSig GhcRn -> [Name]
get_scoped_tvs :: LSig GhcRn -> [Name]
get_scoped_tvs (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LSig GhcRn)
signature)
  | TypeSig _ _ sig <- SrcSpanLess (LSig GhcRn)
signature
  = HsImplicitBndrs GhcRn (LHsType GhcRn) -> [IdP GhcRn]
forall pass (p :: Pass).
(XHsIB pass (LHsType (GhcPass p)) ~ [IdP (GhcPass p)],
 XXHsImplicitBndrs pass (LHsType (GhcPass p)) ~ NoExtCon) =>
HsImplicitBndrs pass (LHsType (GhcPass p)) -> [IdP (GhcPass p)]
get_scoped_tvs_from_sig (HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
sig)
  | ClassOpSig _ _ _ sig <- SrcSpanLess (LSig GhcRn)
signature
  = HsImplicitBndrs GhcRn (LHsType GhcRn) -> [IdP GhcRn]
forall pass (p :: Pass).
(XHsIB pass (LHsType (GhcPass p)) ~ [IdP (GhcPass p)],
 XXHsImplicitBndrs pass (LHsType (GhcPass p)) ~ NoExtCon) =>
HsImplicitBndrs pass (LHsType (GhcPass p)) -> [IdP (GhcPass p)]
get_scoped_tvs_from_sig HsImplicitBndrs GhcRn (LHsType GhcRn)
sig
  | PatSynSig _ _ sig <- SrcSpanLess (LSig GhcRn)
signature
  = HsImplicitBndrs GhcRn (LHsType GhcRn) -> [IdP GhcRn]
forall pass (p :: Pass).
(XHsIB pass (LHsType (GhcPass p)) ~ [IdP (GhcPass p)],
 XXHsImplicitBndrs pass (LHsType (GhcPass p)) ~ NoExtCon) =>
HsImplicitBndrs pass (LHsType (GhcPass p)) -> [IdP (GhcPass p)]
get_scoped_tvs_from_sig HsImplicitBndrs GhcRn (LHsType GhcRn)
sig
  | Bool
otherwise
  = []
  where
    get_scoped_tvs_from_sig :: HsImplicitBndrs pass (LHsType (GhcPass p)) -> [IdP (GhcPass p)]
get_scoped_tvs_from_sig HsImplicitBndrs pass (LHsType (GhcPass p))
sig
      -- Both implicit and explicit quantified variables
      -- We need the implicit ones for   f :: forall (a::k). blah
      --    here 'k' scopes too
      | HsIB { hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
hsib_ext = XHsIB pass (LHsType (GhcPass p))
implicit_vars
             , hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType (GhcPass p)
hs_ty } <- HsImplicitBndrs pass (LHsType (GhcPass p))
sig
      , ([LHsTyVarBndr (GhcPass p)]
explicit_vars, LHsType (GhcPass p)
_) <- LHsType (GhcPass p)
-> ([LHsTyVarBndr (GhcPass p)], LHsType (GhcPass p))
forall pass. LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)
splitLHsForAllTyInvis LHsType (GhcPass p)
hs_ty
      = [IdP (GhcPass p)]
XHsIB pass (LHsType (GhcPass p))
implicit_vars [IdP (GhcPass p)] -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall a. [a] -> [a] -> [a]
++ [LHsTyVarBndr (GhcPass p)] -> [IdP (GhcPass p)]
forall (p :: Pass). [LHsTyVarBndr (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr (GhcPass p)]
explicit_vars
    get_scoped_tvs_from_sig (XHsImplicitBndrs XXHsImplicitBndrs pass (LHsType (GhcPass p))
nec)
      = NoExtCon -> [IdP (GhcPass p)]
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs pass (LHsType (GhcPass p))
NoExtCon
nec

{- Notes

Note [Scoped type variables in bindings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
   f :: forall a. a -> a
   f x = x::a
Here the 'forall a' brings 'a' into scope over the binding group.
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 hsScopedTvBinders

  b) When processing the 'forall', don't gensym

The relevant places are signposted with references to this Note

Note [Scoped type variables in class and instance declarations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Scoped type variables may occur in default methods and default
signatures. We need to bring the type variables in 'foralls'
into the scope of the method bindings.

Consider
   class Foo a where
     foo :: forall (b :: k). a -> Proxy b -> Proxy b
     foo _ x = (x :: Proxy b)

We want to ensure that the 'b' in the type signature and the default
implementation are the same, so we do the following:

  a) Before desugaring the signature and binding of 'foo', use
     get_scoped_tvs to collect type variables in 'forall' and
     create symbols for them.
  b) Use 'addBinds' to bring these symbols into the scope of the type
     signatures and bindings.
  c) Use these symbols to generate Core for the class/instance declaration.

Note that when desugaring the signatures, we lookup the type variables
from the scope rather than recreate symbols for them. See more details
in "rep_ty_sig" and in Trac#14885.

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 suprisingly easy to take this quoted declaration:

  [d| idProxy :: forall proxy (b :: k). proxy b -> proxy b
      idProxy x = x
    |]

and have Template Haskell turn it into this:

  idProxy :: forall k proxy (b :: k). proxy b -> proxy b
  idProxy x = x

Notice that we explicitly quantified the variable `k`! 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 -> DsM (Maybe (SrcSpan, Core TH.DecQ))

repTyClD :: LTyClDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ))
repTyClD (LTyClDecl GhcRn -> Located (SrcSpanLess (LTyClDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (FamDecl { tcdFam = fam })) = ((SrcSpan, Core DecQ) -> Maybe (SrcSpan, Core DecQ))
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SrcSpan, Core DecQ) -> Maybe (SrcSpan, Core DecQ)
forall a. a -> Maybe a
Just (IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
 -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ)))
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ))
forall a b. (a -> b) -> a -> b
$
                                                  LFamilyDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repFamilyDecl (SrcSpan -> FamilyDecl GhcRn -> LFamilyDecl GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc FamilyDecl GhcRn
fam)

repTyClD (LTyClDecl GhcRn -> Located (SrcSpanLess (LTyClDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (SynDecl { tcdLName = tc, tcdTyVars = tvs, tcdRhs = rhs }))
  = do { Core Name
tc1 <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
tc           -- See note [Binders and occurrences]
       ; Core DecQ
dec <- LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a.
LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyClTyVarBinds LHsQTyVars GhcRn
tvs ((Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ))
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a b. (a -> b) -> a -> b
$ \Core [TyVarBndrQ]
bndrs ->
                Core Name -> Core [TyVarBndrQ] -> LHsType GhcRn -> DsM (Core DecQ)
repSynDecl Core Name
tc1 Core [TyVarBndrQ]
bndrs LHsType GhcRn
rhs
       ; Maybe (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ))
forall (m :: * -> *) a. Monad m => a -> m a
return ((SrcSpan, Core DecQ) -> Maybe (SrcSpan, Core DecQ)
forall a. a -> Maybe a
Just (SrcSpan
loc, Core DecQ
dec)) }

repTyClD (LTyClDecl GhcRn -> Located (SrcSpanLess (LTyClDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (DataDecl { tcdLName = tc
                              , tcdTyVars = tvs
                              , tcdDataDefn = defn }))
  = do { Core Name
tc1 <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
tc           -- See note [Binders and occurrences]
       ; Core DecQ
dec <- LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a.
LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyClTyVarBinds LHsQTyVars GhcRn
tvs ((Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ))
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a b. (a -> b) -> a -> b
$ \Core [TyVarBndrQ]
bndrs ->
                Core Name
-> Either
     (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
-> HsDataDefn GhcRn
-> DsM (Core DecQ)
repDataDefn Core Name
tc1 (Core [TyVarBndrQ]
-> Either
     (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
forall a b. a -> Either a b
Left Core [TyVarBndrQ]
bndrs) HsDataDefn GhcRn
defn
       ; Maybe (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ))
forall (m :: * -> *) a. Monad m => a -> m a
return ((SrcSpan, Core DecQ) -> Maybe (SrcSpan, Core DecQ)
forall a. a -> Maybe a
Just (SrcSpan
loc, Core DecQ
dec)) }

repTyClD (LTyClDecl GhcRn -> Located (SrcSpanLess (LTyClDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
                             tcdTyVars = tvs, tcdFDs = fds,
                             tcdSigs = sigs, tcdMeths = meth_binds,
                             tcdATs = ats, tcdATDefs = atds }))
  = do { Core Name
cls1 <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
cls         -- See note [Binders and occurrences]
       ; Core DecQ
dec  <- LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a.
LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyVarBinds LHsQTyVars GhcRn
tvs ((Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ))
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a b. (a -> b) -> a -> b
$ \Core [TyVarBndrQ]
bndrs ->
           do { Core CxtQ
cxt1   <- LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
cxt
          -- See Note [Scoped type variables in class and instance declarations]
              ; ([GenSymBind]
ss, [Core DecQ]
sigs_binds) <- [LSig GhcRn]
-> LHsBindsLR GhcRn GhcRn -> DsM ([GenSymBind], [Core DecQ])
rep_sigs_binds [LSig GhcRn]
sigs LHsBindsLR GhcRn GhcRn
meth_binds
              ; Core [FunDep]
fds1   <- [LHsFunDep GhcRn] -> DsM (Core [FunDep])
repLFunDeps [LHsFunDep GhcRn]
fds
              ; [Core DecQ]
ats1   <- [LFamilyDecl GhcRn] -> DsM [Core DecQ]
repFamilyDecls [LFamilyDecl GhcRn]
ats
              ; [Core DecQ]
atds1  <- (LTyFamDefltDecl GhcRn -> DsM (Core DecQ))
-> [LTyFamDefltDecl GhcRn] -> DsM [Core DecQ]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TyFamDefltDecl GhcRn -> DsM (Core DecQ)
repAssocTyFamDefaultD (TyFamDefltDecl GhcRn -> DsM (Core DecQ))
-> (LTyFamDefltDecl GhcRn -> TyFamDefltDecl GhcRn)
-> LTyFamDefltDecl GhcRn
-> DsM (Core DecQ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTyFamDefltDecl GhcRn -> TyFamDefltDecl GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LTyFamDefltDecl GhcRn]
atds
              ; Core [DecQ]
decls1 <- Name -> [Core DecQ] -> DsM (Core [DecQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
decQTyConName ([Core DecQ]
ats1 [Core DecQ] -> [Core DecQ] -> [Core DecQ]
forall a. [a] -> [a] -> [a]
++ [Core DecQ]
atds1 [Core DecQ] -> [Core DecQ] -> [Core DecQ]
forall a. [a] -> [a] -> [a]
++ [Core DecQ]
sigs_binds)
              ; Core DecQ
decls2 <- Core CxtQ
-> Core Name
-> Core [TyVarBndrQ]
-> Core [FunDep]
-> Core [DecQ]
-> DsM (Core DecQ)
repClass Core CxtQ
cxt1 Core Name
cls1 Core [TyVarBndrQ]
bndrs Core [FunDep]
fds1 Core [DecQ]
decls1
              ; [GenSymBind] -> Core DecQ -> DsM (Core DecQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core DecQ
decls2 }
       ; Maybe (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SrcSpan, Core DecQ)
 -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ)))
-> Maybe (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ))
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Core DecQ) -> Maybe (SrcSpan, Core DecQ)
forall a. a -> Maybe a
Just (SrcSpan
loc, Core DecQ
dec)
       }

repTyClD LTyClDecl GhcRn
_ = String
-> IOEnv (Env DsGblEnv DsLclEnv) (Maybe (SrcSpan, Core DecQ))
forall a. String -> a
panic String
"repTyClD"

-------------------------
repRoleD :: LRoleAnnotDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
repRoleD :: LRoleAnnotDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repRoleD (LRoleAnnotDecl GhcRn
-> Located (SrcSpanLess (LRoleAnnotDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (RoleAnnotDecl _ tycon roles))
  = do { Core Name
tycon1 <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
tycon
       ; [Core Role]
roles1 <- (Located (Maybe Role) -> IOEnv (Env DsGblEnv DsLclEnv) (Core Role))
-> [Located (Maybe Role)]
-> IOEnv (Env DsGblEnv DsLclEnv) [Core Role]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located (Maybe Role) -> IOEnv (Env DsGblEnv DsLclEnv) (Core Role)
repRole [Located (Maybe Role)]
roles
       ; Core [Role]
roles2 <- Name -> [Core Role] -> DsM (Core [Role])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
roleTyConName [Core Role]
roles1
       ; Core DecQ
dec <- Core Name -> Core [Role] -> DsM (Core DecQ)
repRoleAnnotD Core Name
tycon1 Core [Role]
roles2
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
dec) }
repRoleD LRoleAnnotDecl GhcRn
_ = String -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> a
panic String
"repRoleD"

-------------------------
repKiSigD :: LStandaloneKindSig GhcRn -> DsM (SrcSpan, Core TH.DecQ)
repKiSigD :: LStandaloneKindSig GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repKiSigD (LStandaloneKindSig GhcRn
-> Located (SrcSpanLess (LStandaloneKindSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LStandaloneKindSig GhcRn)
kisig) =
  case SrcSpanLess (LStandaloneKindSig GhcRn)
kisig of
    StandaloneKindSig _ v ki -> Name
-> SrcSpan
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> Located Name
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_ty_sig Name
kiSigDName SrcSpan
loc HsImplicitBndrs GhcRn (LHsType GhcRn)
ki Located Name
Located (IdP GhcRn)
v
    XStandaloneKindSig nec -> NoExtCon -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. NoExtCon -> a
noExtCon XXStandaloneKindSig GhcRn
NoExtCon
nec

-------------------------
repDataDefn :: Core TH.Name
            -> Either (Core [TH.TyVarBndrQ])
                        -- the repTyClD case
                      (Core (Maybe [TH.TyVarBndrQ]), Core TH.TypeQ)
                        -- the repDataFamInstD case
            -> HsDataDefn GhcRn
            -> DsM (Core TH.DecQ)
repDataDefn :: Core Name
-> Either
     (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
-> HsDataDefn GhcRn
-> DsM (Core DecQ)
repDataDefn Core Name
tc Either (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
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 CxtQ
cxt1     <- LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
cxt
       ; Core [DerivClauseQ]
derivs1  <- HsDeriving GhcRn -> DsM (Core [DerivClauseQ])
repDerivs HsDeriving GhcRn
mb_derivs
       ; case (NewOrData
new_or_data, [LConDecl GhcRn]
cons) of
           (NewOrData
NewType, [LConDecl GhcRn
con])  -> do { Core ConQ
con'  <- LConDecl GhcRn -> DsM (Core ConQ)
repC LConDecl GhcRn
con
                                   ; Core (Maybe TypeQ)
ksig' <- Maybe (LHsType GhcRn) -> DsM (Core (Maybe TypeQ))
repMaybeLTy Maybe (LHsType GhcRn)
ksig
                                   ; Core CxtQ
-> Core Name
-> Either
     (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
-> Core (Maybe TypeQ)
-> Core ConQ
-> Core [DerivClauseQ]
-> DsM (Core DecQ)
repNewtype Core CxtQ
cxt1 Core Name
tc Either (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
opts Core (Maybe TypeQ)
ksig' Core ConQ
con'
                                                Core [DerivClauseQ]
derivs1 }
           (NewOrData
NewType, [LConDecl GhcRn]
_) -> SDoc -> DsM (Core DecQ)
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 (IdP GhcRn)]
forall (p :: Pass).
ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames (ConDecl GhcRn -> [Located (IdP GhcRn)])
-> ConDecl GhcRn -> [Located (IdP GhcRn)]
forall a b. (a -> b) -> a -> b
$ LConDecl GhcRn -> SrcSpanLess (LConDecl GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LConDecl GhcRn -> SrcSpanLess (LConDecl GhcRn))
-> LConDecl GhcRn -> SrcSpanLess (LConDecl 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 TypeQ)
ksig' <- Maybe (LHsType GhcRn) -> DsM (Core (Maybe TypeQ))
repMaybeLTy Maybe (LHsType GhcRn)
ksig
                               ; [Core ConQ]
consL <- (LConDecl GhcRn -> DsM (Core ConQ))
-> [LConDecl GhcRn] -> IOEnv (Env DsGblEnv DsLclEnv) [Core ConQ]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LConDecl GhcRn -> DsM (Core ConQ)
repC [LConDecl GhcRn]
cons
                               ; Core [ConQ]
cons1 <- Name -> [Core ConQ] -> DsM (Core [ConQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
conQTyConName [Core ConQ]
consL
                               ; Core CxtQ
-> Core Name
-> Either
     (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
-> Core (Maybe TypeQ)
-> Core [ConQ]
-> Core [DerivClauseQ]
-> DsM (Core DecQ)
repData Core CxtQ
cxt1 Core Name
tc Either (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
opts Core (Maybe TypeQ)
ksig' Core [ConQ]
cons1
                                         Core [DerivClauseQ]
derivs1 }
       }
repDataDefn Core Name
_ Either (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
_ (XHsDataDefn XXHsDataDefn GhcRn
nec) = NoExtCon -> DsM (Core DecQ)
forall a. NoExtCon -> a
noExtCon XXHsDataDefn GhcRn
NoExtCon
nec

repSynDecl :: Core TH.Name -> Core [TH.TyVarBndrQ]
           -> LHsType GhcRn
           -> DsM (Core TH.DecQ)
repSynDecl :: Core Name -> Core [TyVarBndrQ] -> LHsType GhcRn -> DsM (Core DecQ)
repSynDecl Core Name
tc Core [TyVarBndrQ]
bndrs LHsType GhcRn
ty
  = do { Core TypeQ
ty1 <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ty
       ; Core Name -> Core [TyVarBndrQ] -> Core TypeQ -> DsM (Core DecQ)
repTySyn Core Name
tc Core [TyVarBndrQ]
bndrs Core TypeQ
ty1 }

repFamilyDecl :: LFamilyDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
repFamilyDecl :: LFamilyDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repFamilyDecl decl :: LFamilyDecl GhcRn
decl@(LFamilyDecl GhcRn -> Located (SrcSpanLess (LFamilyDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (FamilyDecl { fdInfo      = info
                                          , fdLName     = tc
                                          , fdTyVars    = tvs
                                          , fdResultSig = dL->L _ resultSig
                                          , fdInjectivityAnn = injectivity }))
  = do { Core Name
tc1 <- Located Name -> DsM (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 SrcSpanLess (LFamilyResultSig GhcRn)
resultSig of
                     TyVarSig _ bndr -> [LHsTyVarBndr GhcRn] -> LHsQTyVars GhcRn
mkHsQTvs [LHsTyVarBndr GhcRn
bndr]
                     SrcSpanLess (LFamilyResultSig GhcRn)
_               -> [LHsTyVarBndr GhcRn] -> LHsQTyVars GhcRn
mkHsQTvs []
       ; Core DecQ
dec <- LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a.
LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyClTyVarBinds LHsQTyVars GhcRn
tvs ((Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ))
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a b. (a -> b) -> a -> b
$ \Core [TyVarBndrQ]
bndrs ->
                LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a.
LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyClTyVarBinds LHsQTyVars GhcRn
resTyVar ((Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ))
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a b. (a -> b) -> a -> b
$ \Core [TyVarBndrQ]
_ ->
           case FamilyInfo GhcRn
info of
             ClosedTypeFamily Maybe [LTyFamInstEqn GhcRn]
Nothing ->
                 String -> SDoc -> DsM (Core DecQ)
forall a. String -> SDoc -> DsM 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 TySynEqnQ]
eqns1  <- (LTyFamInstEqn GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ))
-> [LTyFamInstEqn GhcRn]
-> IOEnv (Env DsGblEnv DsLclEnv) [Core TySynEqnQ]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TyFamInstEqn GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
repTyFamEqn (TyFamInstEqn GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ))
-> (LTyFamInstEqn GhcRn -> TyFamInstEqn GhcRn)
-> LTyFamInstEqn GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTyFamInstEqn GhcRn -> TyFamInstEqn GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LTyFamInstEqn GhcRn]
eqns
                  ; Core [TySynEqnQ]
eqns2  <- Name -> [Core TySynEqnQ] -> DsM (Core [TySynEqnQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
tySynEqnQTyConName [Core TySynEqnQ]
eqns1
                  ; Core FamilyResultSigQ
result <- FamilyResultSig GhcRn -> DsM (Core FamilyResultSigQ)
repFamilyResultSig SrcSpanLess (LFamilyResultSig GhcRn)
FamilyResultSig GhcRn
resultSig
                  ; Core (Maybe InjectivityAnn)
inj    <- Maybe (LInjectivityAnn GhcRn) -> DsM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn GhcRn)
injectivity
                  ; Core Name
-> Core [TyVarBndrQ]
-> Core FamilyResultSigQ
-> Core (Maybe InjectivityAnn)
-> Core [TySynEqnQ]
-> DsM (Core DecQ)
repClosedFamilyD Core Name
tc1 Core [TyVarBndrQ]
bndrs Core FamilyResultSigQ
result Core (Maybe InjectivityAnn)
inj Core [TySynEqnQ]
eqns2 }
             FamilyInfo GhcRn
OpenTypeFamily ->
               do { Core FamilyResultSigQ
result <- FamilyResultSig GhcRn -> DsM (Core FamilyResultSigQ)
repFamilyResultSig SrcSpanLess (LFamilyResultSig GhcRn)
FamilyResultSig GhcRn
resultSig
                  ; Core (Maybe InjectivityAnn)
inj    <- Maybe (LInjectivityAnn GhcRn) -> DsM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn GhcRn)
injectivity
                  ; Core Name
-> Core [TyVarBndrQ]
-> Core FamilyResultSigQ
-> Core (Maybe InjectivityAnn)
-> DsM (Core DecQ)
repOpenFamilyD Core Name
tc1 Core [TyVarBndrQ]
bndrs Core FamilyResultSigQ
result Core (Maybe InjectivityAnn)
inj }
             FamilyInfo GhcRn
DataFamily ->
               do { Core (Maybe TypeQ)
kind <- FamilyResultSig GhcRn -> DsM (Core (Maybe TypeQ))
repFamilyResultSigToMaybeKind SrcSpanLess (LFamilyResultSig GhcRn)
FamilyResultSig GhcRn
resultSig
                  ; Core Name
-> Core [TyVarBndrQ] -> Core (Maybe TypeQ) -> DsM (Core DecQ)
repDataFamilyD Core Name
tc1 Core [TyVarBndrQ]
bndrs Core (Maybe TypeQ)
kind }
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
dec)
       }
repFamilyDecl LFamilyDecl GhcRn
_ = String -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> a
panic String
"repFamilyDecl"

-- | Represent result signature of a type family
repFamilyResultSig :: FamilyResultSig GhcRn -> DsM (Core TH.FamilyResultSigQ)
repFamilyResultSig :: FamilyResultSig GhcRn -> DsM (Core FamilyResultSigQ)
repFamilyResultSig (NoSig XNoSig GhcRn
_)         = DsM (Core FamilyResultSigQ)
repNoSig
repFamilyResultSig (KindSig XCKindSig GhcRn
_ LHsType GhcRn
ki)    = do { Core TypeQ
ki' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ki
                                          ; Core TypeQ -> DsM (Core FamilyResultSigQ)
repKindSig Core TypeQ
ki' }
repFamilyResultSig (TyVarSig XTyVarSig GhcRn
_ LHsTyVarBndr GhcRn
bndr) = do { Core TyVarBndrQ
bndr' <- LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
repTyVarBndr LHsTyVarBndr GhcRn
bndr
                                          ; Core TyVarBndrQ -> DsM (Core FamilyResultSigQ)
repTyVarSig Core TyVarBndrQ
bndr' }
repFamilyResultSig (XFamilyResultSig XXFamilyResultSig GhcRn
nec) = NoExtCon -> DsM (Core FamilyResultSigQ)
forall a. NoExtCon -> a
noExtCon XXFamilyResultSig GhcRn
NoExtCon
nec

-- | 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
                              -> DsM (Core (Maybe TH.KindQ))
repFamilyResultSigToMaybeKind :: FamilyResultSig GhcRn -> DsM (Core (Maybe TypeQ))
repFamilyResultSigToMaybeKind (NoSig XNoSig GhcRn
_) =
    do { Name -> DsM (Core (Maybe TypeQ))
forall a. Name -> DsM (Core (Maybe a))
coreNothing Name
kindQTyConName }
repFamilyResultSigToMaybeKind (KindSig XCKindSig GhcRn
_ LHsType GhcRn
ki) =
    do { Core TypeQ
ki' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ki
       ; Name -> Core TypeQ -> DsM (Core (Maybe TypeQ))
forall a. Name -> Core a -> DsM (Core (Maybe a))
coreJust Name
kindQTyConName Core TypeQ
ki' }
repFamilyResultSigToMaybeKind FamilyResultSig GhcRn
_ = String -> DsM (Core (Maybe TypeQ))
forall a. String -> a
panic String
"repFamilyResultSigToMaybeKind"

-- | Represent injectivity annotation of a type family
repInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
                  -> DsM (Core (Maybe TH.InjectivityAnn))
repInjectivityAnn :: Maybe (LInjectivityAnn GhcRn) -> DsM (Core (Maybe InjectivityAnn))
repInjectivityAnn Maybe (LInjectivityAnn GhcRn)
Nothing =
    do { Name -> DsM (Core (Maybe InjectivityAnn))
forall a. Name -> DsM (Core (Maybe a))
coreNothing Name
injAnnTyConName }
repInjectivityAnn (Just (LInjectivityAnn GhcRn
-> Located (SrcSpanLess (LInjectivityAnn GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (InjectivityAnn lhs rhs))) =
    do { Core Name
lhs'   <- Name -> DsM (Core Name)
lookupBinder (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
lhs)
       ; [Core Name]
rhs1   <- (Located Name -> DsM (Core Name))
-> [Located Name] -> IOEnv (Env DsGblEnv DsLclEnv) [Core Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name -> DsM (Core Name)
lookupBinder (Name -> DsM (Core Name))
-> (Located Name -> Name) -> Located Name -> DsM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located Name]
[Located (IdP GhcRn)]
rhs
       ; Core [Name]
rhs2   <- Name -> [Core Name] -> DsM (Core [Name])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
nameTyConName [Core Name]
rhs1
       ; Core InjectivityAnn
injAnn <- Name -> [CoreExpr] -> DsM (Core InjectivityAnn)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 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 -> DsM (Core (Maybe InjectivityAnn))
forall a. Name -> Core a -> DsM (Core (Maybe a))
coreJust Name
injAnnTyConName Core InjectivityAnn
injAnn }

repFamilyDecls :: [LFamilyDecl GhcRn] -> DsM [Core TH.DecQ]
repFamilyDecls :: [LFamilyDecl GhcRn] -> DsM [Core DecQ]
repFamilyDecls [LFamilyDecl GhcRn]
fds = ([(SrcSpan, Core DecQ)] -> [Core DecQ])
-> DsM [(SrcSpan, Core DecQ)] -> DsM [Core DecQ]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(SrcSpan, Core DecQ)] -> [Core DecQ]
forall a b. [(a, b)] -> [b]
de_loc ((LFamilyDecl GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LFamilyDecl GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LFamilyDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repFamilyDecl [LFamilyDecl GhcRn]
fds)

repAssocTyFamDefaultD :: TyFamDefltDecl GhcRn -> DsM (Core TH.DecQ)
repAssocTyFamDefaultD :: TyFamDefltDecl GhcRn -> DsM (Core DecQ)
repAssocTyFamDefaultD = TyFamDefltDecl GhcRn -> DsM (Core DecQ)
repTyFamInstD

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

repLFunDep :: LHsFunDep GhcRn -> DsM (Core TH.FunDep)
repLFunDep :: LHsFunDep GhcRn -> DsM (Core FunDep)
repLFunDep (LHsFunDep GhcRn
-> Located (SrcSpanLess (Located (FunDep (Located Name))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (xs, ys))
   = do Core [Name]
xs' <- Name
-> (Located Name -> DsM (Core Name))
-> [Located Name]
-> DsM (Core [Name])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
nameTyConName (Name -> DsM (Core Name)
lookupBinder (Name -> DsM (Core Name))
-> (Located Name -> Name) -> Located Name -> DsM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located Name]
xs
        Core [Name]
ys' <- Name
-> (Located Name -> DsM (Core Name))
-> [Located Name]
-> DsM (Core [Name])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
nameTyConName (Name -> DsM (Core Name)
lookupBinder (Name -> DsM (Core Name))
-> (Located Name -> Name) -> Located Name -> DsM (Core Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located Name]
ys
        Core [Name] -> Core [Name] -> DsM (Core FunDep)
repFunDep Core [Name]
xs' Core [Name]
ys'

-- Represent instance declarations
--
repInstD :: LInstDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
repInstD :: LInstDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repInstD (LInstDecl GhcRn -> Located (SrcSpanLess (LInstDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (TyFamInstD { tfid_inst = fi_decl }))
  = do { Core DecQ
dec <- TyFamDefltDecl GhcRn -> DsM (Core DecQ)
repTyFamInstD TyFamDefltDecl GhcRn
fi_decl
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
dec) }
repInstD (LInstDecl GhcRn -> Located (SrcSpanLess (LInstDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (DataFamInstD { dfid_inst = fi_decl }))
  = do { Core DecQ
dec <- DataFamInstDecl GhcRn -> DsM (Core DecQ)
repDataFamInstD DataFamInstDecl GhcRn
fi_decl
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
dec) }
repInstD (LInstDecl GhcRn -> Located (SrcSpanLess (LInstDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (ClsInstD { cid_inst = cls_decl }))
  = do { Core DecQ
dec <- ClsInstDecl GhcRn -> DsM (Core DecQ)
repClsInstD ClsInstDecl GhcRn
cls_decl
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
dec) }
repInstD LInstDecl GhcRn
_ = String -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> a
panic String
"repInstD"

repClsInstD :: ClsInstDecl GhcRn -> DsM (Core TH.DecQ)
repClsInstD :: ClsInstDecl GhcRn -> DsM (Core DecQ)
repClsInstD (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty = HsImplicitBndrs GhcRn (LHsType 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] -> DsM (Core DecQ) -> DsM (Core DecQ)
forall a. [Name] -> DsM (Core (Q a)) -> DsM (Core (Q a))
addSimpleTyVarBinds [Name]
tvs (DsM (Core DecQ) -> DsM (Core DecQ))
-> DsM (Core DecQ) -> DsM (Core DecQ)
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 CxtQ
cxt1     <- LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
cxt
               ; Core TypeQ
inst_ty1 <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
inst_ty
          -- See Note [Scoped type variables in class and instance declarations]
               ; ([GenSymBind]
ss, [Core DecQ]
sigs_binds) <- [LSig GhcRn]
-> LHsBindsLR GhcRn GhcRn -> DsM ([GenSymBind], [Core DecQ])
rep_sigs_binds [LSig GhcRn]
sigs LHsBindsLR GhcRn GhcRn
binds
               ; [Core DecQ]
ats1   <- (LTyFamDefltDecl GhcRn -> DsM (Core DecQ))
-> [LTyFamDefltDecl GhcRn] -> DsM [Core DecQ]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TyFamDefltDecl GhcRn -> DsM (Core DecQ)
repTyFamInstD (TyFamDefltDecl GhcRn -> DsM (Core DecQ))
-> (LTyFamDefltDecl GhcRn -> TyFamDefltDecl GhcRn)
-> LTyFamDefltDecl GhcRn
-> DsM (Core DecQ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTyFamDefltDecl GhcRn -> TyFamDefltDecl GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LTyFamDefltDecl GhcRn]
ats
               ; [Core DecQ]
adts1  <- (LDataFamInstDecl GhcRn -> DsM (Core DecQ))
-> [LDataFamInstDecl GhcRn] -> DsM [Core DecQ]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DataFamInstDecl GhcRn -> DsM (Core DecQ)
repDataFamInstD (DataFamInstDecl GhcRn -> DsM (Core DecQ))
-> (LDataFamInstDecl GhcRn -> DataFamInstDecl GhcRn)
-> LDataFamInstDecl GhcRn
-> DsM (Core DecQ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDataFamInstDecl GhcRn -> DataFamInstDecl GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LDataFamInstDecl GhcRn]
adts
               ; Core [DecQ]
decls1 <- Name -> [Core DecQ] -> DsM (Core [DecQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
decQTyConName ([Core DecQ]
ats1 [Core DecQ] -> [Core DecQ] -> [Core DecQ]
forall a. [a] -> [a] -> [a]
++ [Core DecQ]
adts1 [Core DecQ] -> [Core DecQ] -> [Core DecQ]
forall a. [a] -> [a] -> [a]
++ [Core DecQ]
sigs_binds)
               ; Core (Maybe Overlap)
rOver  <- Maybe OverlapMode -> DsM (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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Maybe (Located OverlapMode)
overlap)
               ; Core DecQ
decls2 <- Core (Maybe Overlap)
-> Core CxtQ -> Core TypeQ -> Core [DecQ] -> DsM (Core DecQ)
repInst Core (Maybe Overlap)
rOver Core CxtQ
cxt1 Core TypeQ
inst_ty1 Core [DecQ]
decls1
               ; [GenSymBind] -> Core DecQ -> DsM (Core DecQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core DecQ
decls2 }
 where
   ([Name]
tvs, LHsContext GhcRn
cxt, LHsType GhcRn
inst_ty) = HsImplicitBndrs GhcRn (LHsType GhcRn)
-> ([Name], LHsContext GhcRn, LHsType GhcRn)
splitLHsInstDeclTy HsImplicitBndrs GhcRn (LHsType GhcRn)
ty
repClsInstD (XClsInstDecl XXClsInstDecl GhcRn
nec) = NoExtCon -> DsM (Core DecQ)
forall a. NoExtCon -> a
noExtCon XXClsInstDecl GhcRn
NoExtCon
nec

repStandaloneDerivD :: LDerivDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
repStandaloneDerivD :: LDerivDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repStandaloneDerivD (LDerivDecl GhcRn -> Located (SrcSpanLess (LDerivDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (DerivDecl { deriv_strategy = strat
                                          , deriv_type     = ty }))
  = do { Core DecQ
dec <- [Name] -> DsM (Core DecQ) -> DsM (Core DecQ)
forall a. [Name] -> DsM (Core (Q a)) -> DsM (Core (Q a))
addSimpleTyVarBinds [Name]
tvs (DsM (Core DecQ) -> DsM (Core DecQ))
-> DsM (Core DecQ) -> DsM (Core DecQ)
forall a b. (a -> b) -> a -> b
$
                do { Core CxtQ
cxt'     <- LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
cxt
                   ; Core (Maybe DerivStrategyQ)
strat'   <- Maybe (LDerivStrategy GhcRn) -> DsM (Core (Maybe DerivStrategyQ))
repDerivStrategy Maybe (LDerivStrategy GhcRn)
strat
                   ; Core TypeQ
inst_ty' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
inst_ty
                   ; Core (Maybe DerivStrategyQ)
-> Core CxtQ -> Core TypeQ -> DsM (Core DecQ)
repDeriv Core (Maybe DerivStrategyQ)
strat' Core CxtQ
cxt' Core TypeQ
inst_ty' }
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
dec) }
  where
    ([Name]
tvs, LHsContext GhcRn
cxt, LHsType GhcRn
inst_ty) = HsImplicitBndrs GhcRn (LHsType GhcRn)
-> ([Name], LHsContext GhcRn, LHsType GhcRn)
splitLHsInstDeclTy (HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
ty)
repStandaloneDerivD LDerivDecl GhcRn
_ = String -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> a
panic String
"repStandaloneDerivD"

repTyFamInstD :: TyFamInstDecl GhcRn -> DsM (Core TH.DecQ)
repTyFamInstD :: TyFamDefltDecl GhcRn -> DsM (Core DecQ)
repTyFamInstD (TyFamInstDecl { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn = TyFamInstEqn GhcRn
eqn })
  = do { Core TySynEqnQ
eqn1 <- TyFamInstEqn GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
repTyFamEqn TyFamInstEqn GhcRn
eqn
       ; Core TySynEqnQ -> DsM (Core DecQ)
repTySynInst Core TySynEqnQ
eqn1 }

repTyFamEqn :: TyFamInstEqn GhcRn -> DsM (Core TH.TySynEqnQ)
repTyFamEqn :: TyFamInstEqn GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
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 -> DsM (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 [TyVarBndrQ]
    -> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
forall a.
LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyClTyVarBinds LHsQTyVars GhcRn
hs_tvs ((Core [TyVarBndrQ]
  -> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ))
 -> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ))
-> (Core [TyVarBndrQ]
    -> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
forall a b. (a -> b) -> a -> b
$ \ Core [TyVarBndrQ]
_ ->
         do { Core (Maybe [TyVarBndrQ])
mb_bndrs1 <- Name
-> (LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ))
-> Maybe [LHsTyVarBndr GhcRn]
-> DsM (Core (Maybe [TyVarBndrQ]))
forall a b.
Name -> (a -> DsM (Core b)) -> Maybe [a] -> DsM (Core (Maybe [b]))
repMaybeList Name
tyVarBndrQTyConName
                                        LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
repTyVarBndr
                                        Maybe [LHsTyVarBndr GhcRn]
mb_bndrs
            ; Core TypeQ
tys1 <- case LexicalFixity
fixity of
                        LexicalFixity
Prefix -> DsM (Core TypeQ) -> HsTyPats GhcRn -> DsM (Core TypeQ)
repTyArgs (Core Name -> DsM (Core TypeQ)
repNamedTyCon Core Name
tc) HsTyPats GhcRn
tys
                        LexicalFixity
Infix  -> do { (HsValArg LHsType GhcRn
t1: HsValArg LHsType GhcRn
t2: HsTyPats GhcRn
args) <- HsTyPats GhcRn -> DsM (HsTyPats GhcRn)
checkTys HsTyPats GhcRn
tys
                                     ; Core TypeQ
t1' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
t1
                                     ; Core TypeQ
t2'  <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
t2
                                     ; DsM (Core TypeQ) -> HsTyPats GhcRn -> DsM (Core TypeQ)
repTyArgs (Core TypeQ -> Core Name -> Core TypeQ -> DsM (Core TypeQ)
repTInfix Core TypeQ
t1' Core Name
tc Core TypeQ
t2') HsTyPats GhcRn
args }
            ; Core TypeQ
rhs1 <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
rhs
            ; Core (Maybe [TyVarBndrQ])
-> Core TypeQ
-> Core TypeQ
-> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
repTySynEqn Core (Maybe [TyVarBndrQ])
mb_bndrs1 Core TypeQ
tys1 Core TypeQ
rhs1 } }
     where checkTys :: [LHsTypeArg GhcRn] -> DsM [LHsTypeArg GhcRn]
           checkTys :: HsTyPats GhcRn -> DsM (HsTyPats GhcRn)
checkTys tys :: HsTyPats GhcRn
tys@(HsValArg LHsType GhcRn
_:HsValArg LHsType GhcRn
_:HsTyPats GhcRn
_) = HsTyPats GhcRn -> DsM (HsTyPats GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return HsTyPats GhcRn
tys
           checkTys HsTyPats GhcRn
_ = String -> DsM (HsTyPats GhcRn)
forall a. String -> a
panic String
"repTyFamEqn:checkTys"
repTyFamEqn (XHsImplicitBndrs XXHsImplicitBndrs GhcRn (FamEqn GhcRn (LHsType GhcRn))
nec) = NoExtCon -> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs GhcRn (FamEqn GhcRn (LHsType GhcRn))
NoExtCon
nec
repTyFamEqn (HsIB XHsIB GhcRn (FamEqn GhcRn (LHsType GhcRn))
_ (XFamEqn XXFamEqn GhcRn (LHsType GhcRn)
nec)) = NoExtCon -> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
forall a. NoExtCon -> a
noExtCon XXFamEqn GhcRn (LHsType GhcRn)
NoExtCon
nec

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

repDataFamInstD :: DataFamInstDecl GhcRn -> DsM (Core TH.DecQ)
repDataFamInstD :: DataFamInstDecl GhcRn -> DsM (Core DecQ)
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 -> DsM (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 [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a.
LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyClTyVarBinds LHsQTyVars GhcRn
hs_tvs ((Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ))
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a b. (a -> b) -> a -> b
$ \ Core [TyVarBndrQ]
_ ->
         do { Core (Maybe [TyVarBndrQ])
mb_bndrs1 <- Name
-> (LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ))
-> Maybe [LHsTyVarBndr GhcRn]
-> DsM (Core (Maybe [TyVarBndrQ]))
forall a b.
Name -> (a -> DsM (Core b)) -> Maybe [a] -> DsM (Core (Maybe [b]))
repMaybeList Name
tyVarBndrQTyConName
                                        LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
repTyVarBndr
                                        Maybe [LHsTyVarBndr GhcRn]
mb_bndrs
            ; Core TypeQ
tys1 <- case LexicalFixity
fixity of
                        LexicalFixity
Prefix -> DsM (Core TypeQ) -> HsTyPats GhcRn -> DsM (Core TypeQ)
repTyArgs (Core Name -> DsM (Core TypeQ)
repNamedTyCon Core Name
tc) HsTyPats GhcRn
tys
                        LexicalFixity
Infix  -> do { (HsValArg LHsType GhcRn
t1: HsValArg LHsType GhcRn
t2: HsTyPats GhcRn
args) <- HsTyPats GhcRn -> DsM (HsTyPats GhcRn)
checkTys HsTyPats GhcRn
tys
                                     ; Core TypeQ
t1' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
t1
                                     ; Core TypeQ
t2'  <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
t2
                                     ; DsM (Core TypeQ) -> HsTyPats GhcRn -> DsM (Core TypeQ)
repTyArgs (Core TypeQ -> Core Name -> Core TypeQ -> DsM (Core TypeQ)
repTInfix Core TypeQ
t1' Core Name
tc Core TypeQ
t2') HsTyPats GhcRn
args }
            ; Core Name
-> Either
     (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
-> HsDataDefn GhcRn
-> DsM (Core DecQ)
repDataDefn Core Name
tc ((Core (Maybe [TyVarBndrQ]), Core TypeQ)
-> Either
     (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
forall a b. b -> Either a b
Right (Core (Maybe [TyVarBndrQ])
mb_bndrs1, Core TypeQ
tys1)) HsDataDefn GhcRn
defn } }

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

repDataFamInstD (DataFamInstDecl (XHsImplicitBndrs XXHsImplicitBndrs GhcRn (FamEqn GhcRn (HsDataDefn GhcRn))
nec))
  = NoExtCon -> DsM (Core DecQ)
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs GhcRn (FamEqn GhcRn (HsDataDefn GhcRn))
NoExtCon
nec
repDataFamInstD (DataFamInstDecl (HsIB XHsIB GhcRn (FamEqn GhcRn (HsDataDefn GhcRn))
_ (XFamEqn XXFamEqn GhcRn (HsDataDefn GhcRn)
nec)))
  = NoExtCon -> DsM (Core DecQ)
forall a. NoExtCon -> a
noExtCon XXFamEqn GhcRn (HsDataDefn GhcRn)
NoExtCon
nec

repForD :: Located (ForeignDecl GhcRn) -> DsM (SrcSpan, Core TH.DecQ)
repForD :: LForeignDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repForD (LForeignDecl GhcRn -> Located (SrcSpanLess (LForeignDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (ForeignImport { fd_name = name, fd_sig_ty = typ
                                  , fd_fi = CImport (dL->L _ cc)
                                                    (dL->L _ s) mch cis _ }))
 = do MkC CoreExpr
name' <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
name
      MkC CoreExpr
typ' <- HsImplicitBndrs GhcRn (LHsType GhcRn) -> DsM (Core TypeQ)
repHsSigType HsImplicitBndrs GhcRn (LHsType GhcRn)
typ
      MkC CoreExpr
cc' <- CCallConv -> DsM (Core Callconv)
repCCallConv SrcSpanLess (Located CCallConv)
CCallConv
cc
      MkC CoreExpr
s' <- Safety -> DsM (Core Safety)
repSafety SrcSpanLess (Located Safety)
Safety
s
      String
cis' <- CImportSpec -> DsM String
conv_cimportspec CImportSpec
cis
      MkC CoreExpr
str <- String -> DsM (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 DecQ
dec <- Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
forImpDName [CoreExpr
cc', CoreExpr
s', CoreExpr
str, CoreExpr
name', CoreExpr
typ']
      (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
dec)
 where
    conv_cimportspec :: CImportSpec -> DsM String
conv_cimportspec (CLabel CLabelString
cls)
      = String -> SDoc -> DsM String
forall a. String -> SDoc -> DsM 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 -> DsM String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"dynamic"
    conv_cimportspec (CFunction (StaticTarget SourceText
_ CLabelString
fs Maybe UnitId
_ Bool
True))
                            = String -> DsM String
forall (m :: * -> *) a. Monad m => a -> m a
return (CLabelString -> String
unpackFS CLabelString
fs)
    conv_cimportspec (CFunction (StaticTarget SourceText
_ CLabelString
_  Maybe UnitId
_ Bool
False))
                            = String -> DsM String
forall a. String -> a
panic String
"conv_cimportspec: values not supported yet"
    conv_cimportspec CImportSpec
CWrapper = String -> DsM 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 = SrcSpanLess (Located CCallConv)
CCallConv
cc CCallConv -> CCallConv -> Bool
forall a. Eq a => a -> a -> Bool
== CCallConv
PrimCallConv Bool -> Bool -> Bool
|| SrcSpanLess (Located CCallConv)
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 UnitId
_ 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 LForeignDecl GhcRn
decl = String
-> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> SDoc -> DsM a
notHandled String
"Foreign declaration" (LForeignDecl GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr LForeignDecl GhcRn
decl)

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

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

repFixD :: LFixitySig GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
repFixD :: LFixitySig GhcRn -> DsM [(SrcSpan, Core DecQ)]
repFixD (LFixitySig GhcRn -> Located (SrcSpanLess (LFixitySig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (FixitySig _ names (Fixity _ prec dir)))
  = do { MkC CoreExpr
prec' <- Int -> DsM (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 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
do_one Located Name
name
              = do { MkC CoreExpr
name' <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
name
                   ; Core DecQ
dec <- Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
rep_fn [CoreExpr
prec', CoreExpr
name']
                   ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc,Core DecQ
dec) }
       ; (Located Name
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [Located Name] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located Name -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
do_one [Located Name]
[Located (IdP GhcRn)]
names }
repFixD LFixitySig GhcRn
_ = String -> DsM [(SrcSpan, Core DecQ)]
forall a. String -> a
panic String
"repFixD"

repRuleD :: LRuleDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
repRuleD :: LRuleDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repRuleD (LRuleDecl GhcRn -> Located (SrcSpanLess (LRuleDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (HsRule { rd_name = n
                            , rd_act = act
                            , rd_tyvs = ty_bndrs
                            , rd_tmvs = tm_bndrs
                            , rd_lhs = lhs
                            , rd_rhs = rhs }))
  = do { Core DecQ
rule <- [LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a.
[LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addHsTyVarBinds ([LHsTyVarBndr GhcRn]
-> Maybe [LHsTyVarBndr GhcRn] -> [LHsTyVarBndr GhcRn]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LHsTyVarBndr (NoGhcTc GhcRn)]
Maybe [LHsTyVarBndr GhcRn]
ty_bndrs) ((Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ))
-> (Core [TyVarBndrQ] -> DsM (Core DecQ)) -> DsM (Core DecQ)
forall a b. (a -> b) -> a -> b
$ \ Core [TyVarBndrQ]
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] -> DsM [GenSymBind]
mkGenSyms [Name]
tm_bndr_names
            ; Core DecQ
rule <- [GenSymBind] -> DsM (Core DecQ) -> DsM (Core DecQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss (DsM (Core DecQ) -> DsM (Core DecQ))
-> DsM (Core DecQ) -> DsM (Core DecQ)
forall a b. (a -> b) -> a -> b
$
                      do { Core (Maybe [TyVarBndrQ])
ty_bndrs' <- case Maybe [LHsTyVarBndr (NoGhcTc GhcRn)]
ty_bndrs of
                             Maybe [LHsTyVarBndr (NoGhcTc GhcRn)]
Nothing -> Name -> DsM (Core (Maybe [TyVarBndrQ]))
forall a. Name -> DsM (Core (Maybe [a]))
coreNothingList Name
tyVarBndrQTyConName
                             Just [LHsTyVarBndr (NoGhcTc GhcRn)]
_  -> Name -> Core [TyVarBndrQ] -> DsM (Core (Maybe [TyVarBndrQ]))
forall a. Name -> Core [a] -> DsM (Core (Maybe [a]))
coreJustList Name
tyVarBndrQTyConName
                                          Core [TyVarBndrQ]
ex_bndrs
                         ; Core [RuleBndrQ]
tm_bndrs' <- Name
-> (LRuleBndr GhcRn -> DsM (Core RuleBndrQ))
-> [LRuleBndr GhcRn]
-> DsM (Core [RuleBndrQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
ruleBndrQTyConName
                                                LRuleBndr GhcRn -> DsM (Core RuleBndrQ)
repRuleBndr
                                                [LRuleBndr GhcRn]
tm_bndrs
                         ; Core String
n'   <- String -> DsM (Core String)
coreStringLit (String -> DsM (Core String)) -> String -> 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)
-> SrcSpanLess (Located (SourceText, CLabelString))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (SourceText, CLabelString)
n
                         ; Core Phases
act' <- Activation -> DsM (Core Phases)
repPhases Activation
act
                         ; Core ExpQ
lhs' <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
lhs
                         ; Core ExpQ
rhs' <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
rhs
                         ; Core String
-> Core (Maybe [TyVarBndrQ])
-> Core [RuleBndrQ]
-> Core ExpQ
-> Core ExpQ
-> Core Phases
-> DsM (Core DecQ)
repPragRule Core String
n' Core (Maybe [TyVarBndrQ])
ty_bndrs' Core [RuleBndrQ]
tm_bndrs' Core ExpQ
lhs' Core ExpQ
rhs' Core Phases
act' }
           ; [GenSymBind] -> Core DecQ -> DsM (Core DecQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core DecQ
rule  }
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
rule) }
repRuleD LRuleDecl GhcRn
_ = String -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> a
panic String
"repRuleD"

ruleBndrNames :: LRuleBndr GhcRn -> [Name]
ruleBndrNames :: LRuleBndr GhcRn -> [Name]
ruleBndrNames (LRuleBndr GhcRn -> Located (SrcSpanLess (LRuleBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (RuleBndr _ n))      = [Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
n]
ruleBndrNames (LRuleBndr GhcRn -> Located (SrcSpanLess (LRuleBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (RuleBndrSig _ n sig))
  | HsWC { hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsIB { hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
hsib_ext = XHsIB GhcRn (LHsType GhcRn)
vars }} <- HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
sig
  = Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
XHsIB GhcRn (LHsType GhcRn)
vars
ruleBndrNames (LRuleBndr GhcRn -> Located (SrcSpanLess (LRuleBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (RuleBndrSig _ _ (HsWC _ (XHsImplicitBndrs _))))
  = String -> [Name]
forall a. String -> a
panic String
"ruleBndrNames"
ruleBndrNames (LRuleBndr GhcRn -> Located (SrcSpanLess (LRuleBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (RuleBndrSig _ _ (XHsWildCardBndrs _)))
  = String -> [Name]
forall a. String -> a
panic String
"ruleBndrNames"
ruleBndrNames (LRuleBndr GhcRn -> Located (SrcSpanLess (LRuleBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (XRuleBndr nec)) = NoExtCon -> [Name]
forall a. NoExtCon -> a
noExtCon XXRuleBndr GhcRn
NoExtCon
nec
ruleBndrNames LRuleBndr GhcRn
_ = String -> [Name]
forall a. String -> a
panic String
"ruleBndrNames: Impossible Match" -- due to #15884

repRuleBndr :: LRuleBndr GhcRn -> DsM (Core TH.RuleBndrQ)
repRuleBndr :: LRuleBndr GhcRn -> DsM (Core RuleBndrQ)
repRuleBndr (LRuleBndr GhcRn -> Located (SrcSpanLess (LRuleBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (RuleBndr _ n))
  = do { MkC CoreExpr
n' <- Located Name -> DsM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
n
       ; Name -> [CoreExpr] -> DsM (Core RuleBndrQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
ruleVarName [CoreExpr
n'] }
repRuleBndr (LRuleBndr GhcRn -> Located (SrcSpanLess (LRuleBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (RuleBndrSig _ n sig))
  = do { MkC CoreExpr
n'  <- Located Name -> DsM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
n
       ; MkC CoreExpr
ty' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy (HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
-> LHsType GhcRn
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
sig)
       ; Name -> [CoreExpr] -> DsM (Core RuleBndrQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
typedRuleVarName [CoreExpr
n', CoreExpr
ty'] }
repRuleBndr LRuleBndr GhcRn
_ = String -> DsM (Core RuleBndrQ)
forall a. String -> a
panic String
"repRuleBndr"

repAnnD :: LAnnDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
repAnnD :: LAnnDecl GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
repAnnD (LAnnDecl GhcRn -> Located (SrcSpanLess (LAnnDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (HsAnnotation _ _ ann_prov (dL->L _ exp)))
  = do { Core AnnTarget
target <- AnnProvenance Name -> DsM (Core AnnTarget)
repAnnProv AnnProvenance Name
AnnProvenance (IdP GhcRn)
ann_prov
       ; Core ExpQ
exp'   <- HsExpr GhcRn -> DsM (Core ExpQ)
repE SrcSpanLess (LHsExpr GhcRn)
HsExpr GhcRn
exp
       ; Core DecQ
dec    <- Core AnnTarget -> Core ExpQ -> DsM (Core DecQ)
repPragAnn Core AnnTarget
target Core ExpQ
exp'
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
dec) }
repAnnD LAnnDecl GhcRn
_ = String -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> a
panic String
"repAnnD"

repAnnProv :: AnnProvenance Name -> DsM (Core TH.AnnTarget)
repAnnProv :: AnnProvenance Name -> DsM (Core AnnTarget)
repAnnProv (ValueAnnProvenance (Located Name -> Located (SrcSpanLess (Located Name))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located Name)
n))
  = do { MkC CoreExpr
n' <- Name -> DsM (Core Name)
globalVar Name
SrcSpanLess (Located Name)
n  -- ANNs are allowed only at top-level
       ; Name -> [CoreExpr] -> DsM (Core AnnTarget)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
valueAnnotationName [ CoreExpr
n' ] }
repAnnProv (TypeAnnProvenance (Located Name -> Located (SrcSpanLess (Located Name))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located Name)
n))
  = do { MkC CoreExpr
n' <- Name -> DsM (Core Name)
globalVar Name
SrcSpanLess (Located Name)
n
       ; Name -> [CoreExpr] -> DsM (Core AnnTarget)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
typeAnnotationName [ CoreExpr
n' ] }
repAnnProv AnnProvenance Name
ModuleAnnProvenance
  = Name -> [CoreExpr] -> DsM (Core AnnTarget)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
moduleAnnotationName []

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

repC :: LConDecl GhcRn -> DsM (Core TH.ConQ)
repC :: LConDecl GhcRn -> DsM (Core ConQ)
repC (LConDecl GhcRn -> Located (SrcSpanLess (LConDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (ConDeclH98 { con_name   = con
                          , con_forall = (dL->L _ False)
                          , con_mb_cxt = Nothing
                          , con_args   = args }))
  = Located Name -> HsConDeclDetails GhcRn -> DsM (Core ConQ)
repDataCon Located Name
Located (IdP GhcRn)
con HsConDeclDetails GhcRn
args

repC (LConDecl GhcRn -> Located (SrcSpanLess (LConDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (ConDeclH98 { con_name = con
                          , con_forall = (dL->L _ is_existential)
                          , con_ex_tvs = con_tvs
                          , con_mb_cxt = mcxt
                          , con_args = args }))
  = do { [LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core ConQ)) -> DsM (Core ConQ)
forall a.
[LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addHsTyVarBinds [LHsTyVarBndr GhcRn]
con_tvs ((Core [TyVarBndrQ] -> DsM (Core ConQ)) -> DsM (Core ConQ))
-> (Core [TyVarBndrQ] -> DsM (Core ConQ)) -> DsM (Core ConQ)
forall a b. (a -> b) -> a -> b
$ \ Core [TyVarBndrQ]
ex_bndrs ->
         do { Core ConQ
c'    <- Located Name -> HsConDeclDetails GhcRn -> DsM (Core ConQ)
repDataCon Located Name
Located (IdP GhcRn)
con HsConDeclDetails GhcRn
args
            ; Core CxtQ
ctxt' <- Maybe (LHsContext GhcRn) -> DsM (Core CxtQ)
repMbContext Maybe (LHsContext GhcRn)
mcxt
            ; if Bool -> Bool
not Bool
SrcSpanLess (Located Bool)
is_existential Bool -> Bool -> Bool
&& Maybe (LHsContext GhcRn) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (LHsContext GhcRn)
mcxt
              then Core ConQ -> DsM (Core ConQ)
forall (m :: * -> *) a. Monad m => a -> m a
return Core ConQ
c'
              else Name -> [CoreExpr] -> DsM (Core ConQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
forallCName ([Core [TyVarBndrQ] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [TyVarBndrQ]
ex_bndrs, Core CxtQ -> CoreExpr
forall a. Core a -> CoreExpr
unC Core CxtQ
ctxt', Core ConQ -> CoreExpr
forall a. Core a -> CoreExpr
unC Core ConQ
c'])
            }
       }

repC (LConDecl GhcRn -> Located (SrcSpanLess (LConDecl GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (ConDeclGADT { con_names  = cons
                           , con_qvars  = qtvs
                           , con_mb_cxt = mcxt
                           , con_args   = args
                           , con_res_ty = res_ty }))
  | LHsQTyVars GhcRn -> Bool
isEmptyLHsQTvs LHsQTyVars GhcRn
qtvs  -- 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 -> DsM (Core ConQ)
repGadtDataCons [Located Name]
[Located (IdP GhcRn)]
cons HsConDeclDetails GhcRn
args LHsType GhcRn
res_ty

  | Bool
otherwise
  = LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core ConQ)) -> DsM (Core ConQ)
forall a.
LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyVarBinds LHsQTyVars GhcRn
qtvs ((Core [TyVarBndrQ] -> DsM (Core ConQ)) -> DsM (Core ConQ))
-> (Core [TyVarBndrQ] -> DsM (Core ConQ)) -> DsM (Core ConQ)
forall a b. (a -> b) -> a -> b
$ \ Core [TyVarBndrQ]
ex_bndrs ->
             -- See Note [Don't quantify implicit type variables in quotes]
    do { Core ConQ
c'    <- [Located Name]
-> HsConDeclDetails GhcRn -> LHsType GhcRn -> DsM (Core ConQ)
repGadtDataCons [Located Name]
[Located (IdP GhcRn)]
cons HsConDeclDetails GhcRn
args LHsType GhcRn
res_ty
       ; Core CxtQ
ctxt' <- Maybe (LHsContext GhcRn) -> DsM (Core CxtQ)
repMbContext Maybe (LHsContext GhcRn)
mcxt
       ; if [LHsTyVarBndr GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LHsQTyVars GhcRn -> [LHsTyVarBndr GhcRn]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit LHsQTyVars GhcRn
qtvs) Bool -> Bool -> Bool
&& Maybe (LHsContext GhcRn) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (LHsContext GhcRn)
mcxt
         then Core ConQ -> DsM (Core ConQ)
forall (m :: * -> *) a. Monad m => a -> m a
return Core ConQ
c'
         else Name -> [CoreExpr] -> DsM (Core ConQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
forallCName ([Core [TyVarBndrQ] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [TyVarBndrQ]
ex_bndrs, Core CxtQ -> CoreExpr
forall a. Core a -> CoreExpr
unC Core CxtQ
ctxt', Core ConQ -> CoreExpr
forall a. Core a -> CoreExpr
unC Core ConQ
c']) }

repC LConDecl GhcRn
_ = String -> DsM (Core ConQ)
forall a. String -> a
panic String
"repC"


repMbContext :: Maybe (LHsContext GhcRn) -> DsM (Core TH.CxtQ)
repMbContext :: Maybe (LHsContext GhcRn) -> DsM (Core CxtQ)
repMbContext Maybe (LHsContext GhcRn)
Nothing          = HsContext GhcRn -> DsM (Core CxtQ)
repContext []
repMbContext (Just (LHsContext GhcRn -> Located (SrcSpanLess (LHsContext GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LHsContext GhcRn)
cxt)) = HsContext GhcRn -> DsM (Core CxtQ)
repContext HsContext GhcRn
SrcSpanLess (LHsContext GhcRn)
cxt

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

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

repBangTy :: LBangType GhcRn -> DsM (Core (TH.BangTypeQ))
repBangTy :: LHsType GhcRn -> DsM (Core BangTypeQ)
repBangTy LHsType GhcRn
ty = do
  MkC CoreExpr
u <- SrcUnpackedness -> DsM (Core SourceUnpackednessQ)
repSrcUnpackedness SrcUnpackedness
su'
  MkC CoreExpr
s <- SrcStrictness -> DsM (Core SourceStrictnessQ)
repSrcStrictness SrcStrictness
ss'
  MkC CoreExpr
b <- Name -> [CoreExpr] -> DsM (Core Any)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
bangName [CoreExpr
u, CoreExpr
s]
  MkC CoreExpr
t <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ty'
  Name -> [CoreExpr] -> DsM (Core BangTypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
bangTypeName [CoreExpr
b, CoreExpr
t]
  where
    (SrcUnpackedness
su', SrcStrictness
ss', LHsType GhcRn
ty') = case LHsType GhcRn -> SrcSpanLess (LHsType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcRn
ty of
            HsBangTy _ (HsSrcBang _ su ss) ty -> (SrcUnpackedness
su, SrcStrictness
ss, LHsType GhcRn
ty)
            SrcSpanLess (LHsType GhcRn)
_ -> (SrcUnpackedness
NoSrcUnpack, SrcStrictness
NoSrcStrict, LHsType GhcRn
ty)

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

repDerivs :: HsDeriving GhcRn -> DsM (Core [TH.DerivClauseQ])
repDerivs :: HsDeriving GhcRn -> DsM (Core [DerivClauseQ])
repDerivs (HsDeriving GhcRn -> Located (SrcSpanLess (HsDeriving GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (HsDeriving GhcRn)
clauses)
  = Name
-> (LHsDerivingClause GhcRn -> DsM (Core DerivClauseQ))
-> [LHsDerivingClause GhcRn]
-> DsM (Core [DerivClauseQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
derivClauseQTyConName LHsDerivingClause GhcRn -> DsM (Core DerivClauseQ)
repDerivClause [LHsDerivingClause GhcRn]
SrcSpanLess (HsDeriving GhcRn)
clauses

repDerivClause :: LHsDerivingClause GhcRn
               -> DsM (Core TH.DerivClauseQ)
repDerivClause :: LHsDerivingClause GhcRn -> DsM (Core DerivClauseQ)
repDerivClause (LHsDerivingClause GhcRn
-> Located (SrcSpanLess (LHsDerivingClause GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (HsDerivingClause
                          { deriv_clause_strategy = dcs
                          , deriv_clause_tys      = (dL->L _ dct) }))
  = do MkC CoreExpr
dcs' <- Maybe (LDerivStrategy GhcRn) -> DsM (Core (Maybe DerivStrategyQ))
repDerivStrategy Maybe (LDerivStrategy GhcRn)
dcs
       MkC CoreExpr
dct' <- Name
-> (HsImplicitBndrs GhcRn (LHsType GhcRn) -> DsM (Core TypeQ))
-> [HsImplicitBndrs GhcRn (LHsType GhcRn)]
-> DsM (Core [TypeQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
typeQTyConName (LHsType GhcRn -> DsM (Core TypeQ)
rep_deriv_ty (LHsType GhcRn -> DsM (Core TypeQ))
-> (HsImplicitBndrs GhcRn (LHsType GhcRn) -> LHsType GhcRn)
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> DsM (Core TypeQ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsImplicitBndrs GhcRn (LHsType GhcRn) -> LHsType GhcRn
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType) [HsImplicitBndrs GhcRn (LHsType GhcRn)]
SrcSpanLess (Located [HsImplicitBndrs GhcRn (LHsType GhcRn)])
dct
       Name -> [CoreExpr] -> DsM (Core DerivClauseQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
derivClauseName [CoreExpr
dcs',CoreExpr
dct']
  where
    rep_deriv_ty :: LHsType GhcRn -> DsM (Core TH.TypeQ)
    rep_deriv_ty :: LHsType GhcRn -> DsM (Core TypeQ)
rep_deriv_ty LHsType GhcRn
ty = LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ty
repDerivClause LHsDerivingClause GhcRn
_ = String -> DsM (Core DerivClauseQ)
forall a. String -> a
panic String
"repDerivClause"

rep_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn
               -> DsM ([GenSymBind], [Core TH.DecQ])
-- Represent signatures and methods in class/instance declarations.
-- See Note [Scoped type variables in class and instance declarations]
--
-- 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_sigs_binds :: [LSig GhcRn]
-> LHsBindsLR GhcRn GhcRn -> DsM ([GenSymBind], [Core DecQ])
rep_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] -> DsM [GenSymBind]
mkGenSyms [Name]
tvs
       ; [(SrcSpan, Core DecQ)]
sigs1 <- [GenSymBind]
-> DsM [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss (DsM [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)])
-> DsM [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall a b. (a -> b) -> a -> b
$ [LSig GhcRn] -> DsM [(SrcSpan, Core DecQ)]
rep_sigs [LSig GhcRn]
sigs
       ; [(SrcSpan, Core DecQ)]
binds1 <- [GenSymBind]
-> DsM [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss (DsM [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)])
-> DsM [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall a b. (a -> b) -> a -> b
$ LHsBindsLR GhcRn GhcRn -> DsM [(SrcSpan, Core DecQ)]
rep_binds LHsBindsLR GhcRn GhcRn
binds
       ; ([GenSymBind], [Core DecQ]) -> DsM ([GenSymBind], [Core DecQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss, [(SrcSpan, Core DecQ)] -> [Core DecQ]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core DecQ)] -> [(SrcSpan, Core DecQ)]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc ([(SrcSpan, Core DecQ)]
sigs1 [(SrcSpan, Core DecQ)]
-> [(SrcSpan, Core DecQ)] -> [(SrcSpan, Core DecQ)]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core DecQ)]
binds1))) }

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

rep_sigs :: [LSig GhcRn] -> DsM [(SrcSpan, Core TH.DecQ)]
        -- We silently ignore ones we don't recognise
rep_sigs :: [LSig GhcRn] -> DsM [(SrcSpan, Core DecQ)]
rep_sigs = (LSig GhcRn -> DsM [(SrcSpan, Core DecQ)])
-> [LSig GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM LSig GhcRn -> DsM [(SrcSpan, Core DecQ)]
rep_sig

rep_sig :: LSig GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
rep_sig :: LSig GhcRn -> DsM [(SrcSpan, Core DecQ)]
rep_sig (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (TypeSig _ nms ty))
  = (Located Name
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [Located Name] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name
-> SrcSpan
-> HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
-> Located Name
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_wc_ty_sig Name
sigDName SrcSpan
loc HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
ty) [Located Name]
[Located (IdP GhcRn)]
nms
rep_sig (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (PatSynSig _ nms ty))
  = (Located Name
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [Located Name] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SrcSpan
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> Located Name
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_patsyn_ty_sig SrcSpan
loc HsImplicitBndrs GhcRn (LHsType GhcRn)
ty) [Located Name]
[Located (IdP GhcRn)]
nms
rep_sig (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (ClassOpSig _ is_deflt nms ty))
  | Bool
is_deflt     = (Located Name
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [Located Name] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name
-> SrcSpan
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> Located Name
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_ty_sig Name
defaultSigDName SrcSpan
loc HsImplicitBndrs GhcRn (LHsType GhcRn)
ty) [Located Name]
[Located (IdP GhcRn)]
nms
  | Bool
otherwise    = (Located Name
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [Located Name] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name
-> SrcSpan
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> Located Name
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_ty_sig Name
sigDName SrcSpan
loc HsImplicitBndrs GhcRn (LHsType GhcRn)
ty) [Located Name]
[Located (IdP GhcRn)]
nms
rep_sig d :: LSig GhcRn
d@(LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (IdSig {}))           = String -> SDoc -> DsM [(SrcSpan, Core DecQ)]
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 (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_   (FixSig {}))          = [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall (m :: * -> *) a. Monad m => a -> m a
return [] -- fixity sigs at top level
rep_sig (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (InlineSig _ nm ispec))= Located Name
-> InlinePragma -> SrcSpan -> DsM [(SrcSpan, Core DecQ)]
rep_inline Located Name
Located (IdP GhcRn)
nm InlinePragma
ispec SrcSpan
loc
rep_sig (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (SpecSig _ nm tys ispec))
  = (HsImplicitBndrs GhcRn (LHsType GhcRn)
 -> DsM [(SrcSpan, Core DecQ)])
-> [HsImplicitBndrs GhcRn (LHsType GhcRn)]
-> DsM [(SrcSpan, Core DecQ)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (\HsImplicitBndrs GhcRn (LHsType GhcRn)
t -> Located Name
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> InlinePragma
-> SrcSpan
-> DsM [(SrcSpan, Core DecQ)]
rep_specialise Located Name
Located (IdP GhcRn)
nm HsImplicitBndrs GhcRn (LHsType GhcRn)
t InlinePragma
ispec SrcSpan
loc) [HsImplicitBndrs GhcRn (LHsType GhcRn)]
tys
rep_sig (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (SpecInstSig _ _ ty))  = HsImplicitBndrs GhcRn (LHsType GhcRn)
-> SrcSpan -> DsM [(SrcSpan, Core DecQ)]
rep_specialiseInst HsImplicitBndrs GhcRn (LHsType GhcRn)
ty SrcSpan
loc
rep_sig (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_   (MinimalSig {}))       = String -> SDoc -> DsM [(SrcSpan, Core DecQ)]
forall a. String -> SDoc -> DsM a
notHandled String
"MINIMAL pragmas" SDoc
empty
rep_sig (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_   (SCCFunSig {}))        = String -> SDoc -> DsM [(SrcSpan, Core DecQ)]
forall a. String -> SDoc -> DsM a
notHandled String
"SCC pragmas" SDoc
empty
rep_sig (LSig GhcRn -> Located (SrcSpanLess (LSig GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (CompleteMatchSig _ _st cls mty))
  = Located [Located Name]
-> Maybe (Located Name) -> SrcSpan -> DsM [(SrcSpan, Core DecQ)]
rep_complete_sig Located [Located Name]
Located [Located (IdP GhcRn)]
cls Maybe (Located Name)
Maybe (Located (IdP GhcRn))
mty SrcSpan
loc
rep_sig LSig GhcRn
_ = String -> DsM [(SrcSpan, Core DecQ)]
forall a. String -> a
panic String
"rep_sig"

rep_ty_sig :: Name -> SrcSpan -> LHsSigType GhcRn -> Located Name
           -> DsM (SrcSpan, Core TH.DecQ)
-- Don't create the implicit and explicit variables when desugaring signatures,
-- see Note [Scoped type variables in class and instance declarations].
-- and Note [Don't quantify implicit type variables in quotes]
rep_ty_sig :: Name
-> SrcSpan
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> Located Name
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_ty_sig Name
mk_sig SrcSpan
loc HsImplicitBndrs GhcRn (LHsType GhcRn)
sig_ty Located Name
nm
  | HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcRn
hs_ty } <- HsImplicitBndrs GhcRn (LHsType GhcRn)
sig_ty
  , ([LHsTyVarBndr GhcRn]
explicit_tvs, LHsContext GhcRn
ctxt, LHsType GhcRn
ty) <- LHsType GhcRn
-> ([LHsTyVarBndr GhcRn], LHsContext GhcRn, LHsType GhcRn)
forall pass.
LHsType pass
-> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)
splitLHsSigmaTyInvis LHsType GhcRn
hs_ty
  = do { Core Name
nm1 <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
nm
       ; let rep_in_scope_tv :: LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
rep_in_scope_tv LHsTyVarBndr GhcRn
tv = do { Core Name
name <- Name -> DsM (Core Name)
lookupBinder (LHsTyVarBndr GhcRn -> IdP GhcRn
forall (p :: Pass). LHsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName LHsTyVarBndr GhcRn
tv)
                                     ; LHsTyVarBndr GhcRn -> Core Name -> DsM (Core TyVarBndrQ)
repTyVarBndrWithKind LHsTyVarBndr GhcRn
tv Core Name
name }
       ; Core [TyVarBndrQ]
th_explicit_tvs <- Name
-> (LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ))
-> [LHsTyVarBndr GhcRn]
-> DsM (Core [TyVarBndrQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
tyVarBndrQTyConName LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
rep_in_scope_tv
                                    [LHsTyVarBndr GhcRn]
explicit_tvs

         -- NB: Don't pass any implicit type variables to repList above
         -- See Note [Don't quantify implicit type variables in quotes]

       ; Core CxtQ
th_ctxt <- LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
ctxt
       ; Core TypeQ
th_ty   <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ty
       ; Core TypeQ
ty1     <- if [LHsTyVarBndr GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr GhcRn]
explicit_tvs Bool -> Bool -> Bool
&& HsContext GhcRn -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LHsContext GhcRn -> SrcSpanLess (LHsContext GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsContext GhcRn
ctxt)
                       then Core TypeQ -> DsM (Core TypeQ)
forall (m :: * -> *) a. Monad m => a -> m a
return Core TypeQ
th_ty
                       else Core [TyVarBndrQ] -> Core CxtQ -> Core TypeQ -> DsM (Core TypeQ)
repTForall Core [TyVarBndrQ]
th_explicit_tvs Core CxtQ
th_ctxt Core TypeQ
th_ty
       ; Core DecQ
sig     <- Name -> Core Name -> Core TypeQ -> DsM (Core DecQ)
repProto Name
mk_sig Core Name
nm1 Core TypeQ
ty1
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
sig) }
rep_ty_sig Name
_ SrcSpan
_ (XHsImplicitBndrs XXHsImplicitBndrs GhcRn (LHsType GhcRn)
nec) Located Name
_ = NoExtCon -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs GhcRn (LHsType GhcRn)
NoExtCon
nec

rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> Located Name
                  -> DsM (SrcSpan, Core TH.DecQ)
-- represents a pattern synonym type signature;
-- see Note [Pattern synonym type signatures and Template Haskell] in Convert
--
-- Don't create the implicit and explicit variables when desugaring signatures,
-- see Note [Scoped type variables in class and instance declarations]
-- and Note [Don't quantify implicit type variables in quotes]
rep_patsyn_ty_sig :: SrcSpan
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> Located Name
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_patsyn_ty_sig SrcSpan
loc HsImplicitBndrs GhcRn (LHsType GhcRn)
sig_ty Located Name
nm
  | HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = LHsType GhcRn
hs_ty } <- HsImplicitBndrs GhcRn (LHsType GhcRn)
sig_ty
  , ([LHsTyVarBndr GhcRn]
univs, LHsContext GhcRn
reqs, [LHsTyVarBndr GhcRn]
exis, LHsContext GhcRn
provs, LHsType GhcRn
ty) <- LHsType GhcRn
-> ([LHsTyVarBndr GhcRn], LHsContext GhcRn, [LHsTyVarBndr GhcRn],
    LHsContext GhcRn, LHsType GhcRn)
forall pass.
LHsType pass
-> ([LHsTyVarBndr pass], LHsContext pass, [LHsTyVarBndr pass],
    LHsContext pass, LHsType pass)
splitLHsPatSynTy LHsType GhcRn
hs_ty
  = do { Core Name
nm1 <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
nm
       ; let rep_in_scope_tv :: LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
rep_in_scope_tv LHsTyVarBndr GhcRn
tv = do { Core Name
name <- Name -> DsM (Core Name)
lookupBinder (LHsTyVarBndr GhcRn -> IdP GhcRn
forall (p :: Pass). LHsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName LHsTyVarBndr GhcRn
tv)
                                     ; LHsTyVarBndr GhcRn -> Core Name -> DsM (Core TyVarBndrQ)
repTyVarBndrWithKind LHsTyVarBndr GhcRn
tv Core Name
name }
       ; Core [TyVarBndrQ]
th_univs <- Name
-> (LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ))
-> [LHsTyVarBndr GhcRn]
-> DsM (Core [TyVarBndrQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
tyVarBndrQTyConName LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
rep_in_scope_tv [LHsTyVarBndr GhcRn]
univs
       ; Core [TyVarBndrQ]
th_exis  <- Name
-> (LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ))
-> [LHsTyVarBndr GhcRn]
-> DsM (Core [TyVarBndrQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
tyVarBndrQTyConName LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
rep_in_scope_tv [LHsTyVarBndr GhcRn]
exis

         -- NB: Don't pass any implicit type variables to repList above
         -- See Note [Don't quantify implicit type variables in quotes]

       ; Core CxtQ
th_reqs  <- LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
reqs
       ; Core CxtQ
th_provs <- LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
provs
       ; Core TypeQ
th_ty    <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ty
       ; Core TypeQ
ty1      <- Core [TyVarBndrQ] -> Core CxtQ -> Core TypeQ -> DsM (Core TypeQ)
repTForall Core [TyVarBndrQ]
th_univs Core CxtQ
th_reqs (Core TypeQ -> DsM (Core TypeQ))
-> DsM (Core TypeQ) -> DsM (Core TypeQ)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                       Core [TyVarBndrQ] -> Core CxtQ -> Core TypeQ -> DsM (Core TypeQ)
repTForall Core [TyVarBndrQ]
th_exis Core CxtQ
th_provs Core TypeQ
th_ty
       ; Core DecQ
sig      <- Name -> Core Name -> Core TypeQ -> DsM (Core DecQ)
repProto Name
patSynSigDName Core Name
nm1 Core TypeQ
ty1
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
sig) }
rep_patsyn_ty_sig SrcSpan
_ (XHsImplicitBndrs XXHsImplicitBndrs GhcRn (LHsType GhcRn)
nec) Located Name
_ = NoExtCon -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs GhcRn (LHsType GhcRn)
NoExtCon
nec

rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> Located Name
              -> DsM (SrcSpan, Core TH.DecQ)
rep_wc_ty_sig :: Name
-> SrcSpan
-> HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
-> Located Name
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_wc_ty_sig Name
mk_sig SrcSpan
loc HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
sig_ty Located Name
nm
  = Name
-> SrcSpan
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> Located Name
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_ty_sig Name
mk_sig SrcSpan
loc (HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
sig_ty) Located Name
nm

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

rep_specialise :: Located Name -> LHsSigType GhcRn -> InlinePragma
               -> SrcSpan
               -> DsM [(SrcSpan, Core TH.DecQ)]
rep_specialise :: Located Name
-> HsImplicitBndrs GhcRn (LHsType GhcRn)
-> InlinePragma
-> SrcSpan
-> DsM [(SrcSpan, Core DecQ)]
rep_specialise Located Name
nm HsImplicitBndrs GhcRn (LHsType GhcRn)
ty InlinePragma
ispec SrcSpan
loc
  = do { Core Name
nm1 <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
nm
       ; Core TypeQ
ty1 <- HsImplicitBndrs GhcRn (LHsType GhcRn) -> DsM (Core TypeQ)
repHsSigType HsImplicitBndrs GhcRn (LHsType GhcRn)
ty
       ; Core Phases
phases <- Activation -> DsM (Core Phases)
repPhases (Activation -> DsM (Core Phases))
-> Activation -> DsM (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 DecQ
pragma <- if InlineSpec -> Bool
noUserInlineSpec InlineSpec
inline
                   then -- SPECIALISE
                     Core Name -> Core TypeQ -> Core Phases -> DsM (Core DecQ)
repPragSpec Core Name
nm1 Core TypeQ
ty1 Core Phases
phases
                   else -- SPECIALISE INLINE
                     do { Core Inline
inline1 <- InlineSpec -> DsM (Core Inline)
repInline InlineSpec
inline
                        ; Core Name
-> Core TypeQ -> Core Inline -> Core Phases -> DsM (Core DecQ)
repPragSpecInl Core Name
nm1 Core TypeQ
ty1 Core Inline
inline1 Core Phases
phases }
       ; [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core DecQ
pragma)]
       }

rep_specialiseInst :: LHsSigType GhcRn -> SrcSpan
                   -> DsM [(SrcSpan, Core TH.DecQ)]
rep_specialiseInst :: HsImplicitBndrs GhcRn (LHsType GhcRn)
-> SrcSpan -> DsM [(SrcSpan, Core DecQ)]
rep_specialiseInst HsImplicitBndrs GhcRn (LHsType GhcRn)
ty SrcSpan
loc
  = do { Core TypeQ
ty1    <- HsImplicitBndrs GhcRn (LHsType GhcRn) -> DsM (Core TypeQ)
repHsSigType HsImplicitBndrs GhcRn (LHsType GhcRn)
ty
       ; Core DecQ
pragma <- Core TypeQ -> DsM (Core DecQ)
repPragSpecInst Core TypeQ
ty1
       ; [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core DecQ
pragma)] }

repInline :: InlineSpec -> DsM (Core TH.Inline)
repInline :: InlineSpec -> DsM (Core Inline)
repInline InlineSpec
NoInline  = Name -> DsM (Core Inline)
forall a. Name -> DsM (Core a)
dataCon Name
noInlineDataConName
repInline InlineSpec
Inline    = Name -> DsM (Core Inline)
forall a. Name -> DsM (Core a)
dataCon Name
inlineDataConName
repInline InlineSpec
Inlinable = Name -> DsM (Core Inline)
forall a. Name -> DsM (Core a)
dataCon Name
inlinableDataConName
repInline InlineSpec
spec      = String -> SDoc -> DsM (Core Inline)
forall a. String -> SDoc -> DsM a
notHandled String
"repInline" (InlineSpec -> SDoc
forall a. Outputable a => a -> SDoc
ppr InlineSpec
spec)

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

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

rep_complete_sig :: Located [Located Name]
                 -> Maybe (Located Name)
                 -> SrcSpan
                 -> DsM [(SrcSpan, Core TH.DecQ)]
rep_complete_sig :: Located [Located Name]
-> Maybe (Located Name) -> SrcSpan -> DsM [(SrcSpan, Core DecQ)]
rep_complete_sig (Located [Located Name]
-> Located (SrcSpanLess (Located [Located Name]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located [Located Name])
cls) Maybe (Located Name)
mty SrcSpan
loc
  = do { Core (Maybe Name)
mty' <- Name
-> (Located Name -> DsM (Core Name))
-> Maybe (Located Name)
-> DsM (Core (Maybe Name))
forall a b.
Name -> (a -> DsM (Core b)) -> Maybe a -> DsM (Core (Maybe b))
repMaybe Name
nameTyConName Located Name -> DsM (Core Name)
lookupLOcc Maybe (Located Name)
mty
       ; Core [Name]
cls' <- Name
-> (Located Name -> DsM (Core Name))
-> [Located Name]
-> DsM (Core [Name])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
nameTyConName Located Name -> DsM (Core Name)
lookupLOcc [Located Name]
SrcSpanLess (Located [Located Name])
cls
       ; Core DecQ
sig <- Core [Name] -> Core (Maybe Name) -> DsM (Core DecQ)
repPragComplete Core [Name]
cls' Core (Maybe Name)
mty'
       ; [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
loc, Core DecQ
sig)] }

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

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

addHsTyVarBinds :: [LHsTyVarBndr GhcRn]  -- the binders to be added
                -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))  -- action in the ext env
                -> DsM (Core (TH.Q a))
addHsTyVarBinds :: [LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addHsTyVarBinds [LHsTyVarBndr GhcRn]
exp_tvs Core [TyVarBndrQ] -> DsM (Core (Q a))
thing_inside
  = do { [GenSymBind]
fresh_exp_names <- [Name] -> DsM [GenSymBind]
mkGenSyms ([LHsTyVarBndr GhcRn] -> [IdP GhcRn]
forall (p :: Pass). [LHsTyVarBndr (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames [LHsTyVarBndr GhcRn]
exp_tvs)
       ; Core (Q a)
term <- [GenSymBind] -> DsM (Core (Q a)) -> DsM (Core (Q a))
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
fresh_exp_names (DsM (Core (Q a)) -> DsM (Core (Q a)))
-> DsM (Core (Q a)) -> DsM (Core (Q a))
forall a b. (a -> b) -> a -> b
$
                 do { Core [TyVarBndrQ]
kbs <- Name
-> ((LHsTyVarBndr GhcRn, GenSymBind) -> DsM (Core TyVarBndrQ))
-> [(LHsTyVarBndr GhcRn, GenSymBind)]
-> DsM (Core [TyVarBndrQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
tyVarBndrQTyConName (LHsTyVarBndr GhcRn, GenSymBind) -> DsM (Core TyVarBndrQ)
forall a. (LHsTyVarBndr GhcRn, (a, Id)) -> DsM (Core TyVarBndrQ)
mk_tv_bndr
                                     ([LHsTyVarBndr GhcRn]
exp_tvs [LHsTyVarBndr GhcRn]
-> [GenSymBind] -> [(LHsTyVarBndr GhcRn, GenSymBind)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [GenSymBind]
fresh_exp_names)
                    ; Core [TyVarBndrQ] -> DsM (Core (Q a))
thing_inside Core [TyVarBndrQ]
kbs }
       ; [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
fresh_exp_names Core (Q a)
term }
  where
    mk_tv_bndr :: (LHsTyVarBndr GhcRn, (a, Id)) -> DsM (Core TyVarBndrQ)
mk_tv_bndr (LHsTyVarBndr GhcRn
tv, (a
_,Id
v)) = LHsTyVarBndr GhcRn -> Core Name -> DsM (Core TyVarBndrQ)
repTyVarBndrWithKind LHsTyVarBndr GhcRn
tv (Id -> Core Name
coreVar Id
v)

addTyVarBinds :: LHsQTyVars GhcRn                    -- the binders to be added
              -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))  -- action in the ext env
              -> DsM (Core (TH.Q 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 :: LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyVarBinds (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 [TyVarBndrQ] -> DsM (Core (Q a))
thing_inside
  = [Name] -> DsM (Core (Q a)) -> DsM (Core (Q a))
forall a. [Name] -> DsM (Core (Q a)) -> DsM (Core (Q a))
addSimpleTyVarBinds [Name]
XHsQTvs GhcRn
imp_tvs (DsM (Core (Q a)) -> DsM (Core (Q a)))
-> DsM (Core (Q a)) -> DsM (Core (Q a))
forall a b. (a -> b) -> a -> b
$
    [LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
forall a.
[LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addHsTyVarBinds [LHsTyVarBndr GhcRn]
exp_tvs ((Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a)))
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
forall a b. (a -> b) -> a -> b
$
    Core [TyVarBndrQ] -> DsM (Core (Q a))
thing_inside
addTyVarBinds (XLHsQTyVars XXLHsQTyVars GhcRn
nec) Core [TyVarBndrQ] -> DsM (Core (Q a))
_ = NoExtCon -> DsM (Core (Q a))
forall a. NoExtCon -> a
noExtCon XXLHsQTyVars GhcRn
NoExtCon
nec

addTyClTyVarBinds :: LHsQTyVars GhcRn
                  -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))
                  -> DsM (Core (TH.Q 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 :: LHsQTyVars GhcRn
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addTyClTyVarBinds LHsQTyVars GhcRn
tvs Core [TyVarBndrQ] -> DsM (Core (Q a))
m
  = do { let tv_names :: [Name]
tv_names = LHsQTyVars GhcRn -> [Name]
hsAllLTyVarNames LHsQTyVars GhcRn
tvs
       ; DsMetaEnv
env <- DsM DsMetaEnv
dsGetMetaEnv
       ; [GenSymBind]
freshNames <- [Name] -> DsM [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 (Q a)
term <- [GenSymBind] -> DsM (Core (Q a)) -> DsM (Core (Q a))
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
freshNames (DsM (Core (Q a)) -> DsM (Core (Q a)))
-> DsM (Core (Q a)) -> DsM (Core (Q a))
forall a b. (a -> b) -> a -> b
$
                 do { Core [TyVarBndrQ]
kbs <- Name
-> (LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ))
-> [LHsTyVarBndr GhcRn]
-> DsM (Core [TyVarBndrQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
tyVarBndrQTyConName LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
mk_tv_bndr
                                     (LHsQTyVars GhcRn -> [LHsTyVarBndr GhcRn]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit LHsQTyVars GhcRn
tvs)
                    ; Core [TyVarBndrQ] -> DsM (Core (Q a))
m Core [TyVarBndrQ]
kbs }

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

-- Produce kinded binder constructors from the Haskell tyvar binders
--
repTyVarBndrWithKind :: LHsTyVarBndr GhcRn
                     -> Core TH.Name -> DsM (Core TH.TyVarBndrQ)
repTyVarBndrWithKind :: LHsTyVarBndr GhcRn -> Core Name -> DsM (Core TyVarBndrQ)
repTyVarBndrWithKind (LHsTyVarBndr GhcRn -> Located (SrcSpanLess (LHsTyVarBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (UserTyVar _ _)) Core Name
nm
  = Core Name -> DsM (Core TyVarBndrQ)
repPlainTV Core Name
nm
repTyVarBndrWithKind (LHsTyVarBndr GhcRn -> Located (SrcSpanLess (LHsTyVarBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (KindedTyVar _ _ ki)) Core Name
nm
  = LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ki DsM (Core TypeQ)
-> (Core TypeQ -> DsM (Core TyVarBndrQ)) -> DsM (Core TyVarBndrQ)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Core Name -> Core TypeQ -> DsM (Core TyVarBndrQ)
repKindedTV Core Name
nm
repTyVarBndrWithKind LHsTyVarBndr GhcRn
_ Core Name
_ = String -> DsM (Core TyVarBndrQ)
forall a. String -> a
panic String
"repTyVarBndrWithKind"

-- | Represent a type variable binder
repTyVarBndr :: LHsTyVarBndr GhcRn -> DsM (Core TH.TyVarBndrQ)
repTyVarBndr :: LHsTyVarBndr GhcRn -> DsM (Core TyVarBndrQ)
repTyVarBndr (LHsTyVarBndr GhcRn -> Located (SrcSpanLess (LHsTyVarBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (UserTyVar _ (dL->L _ nm)) )
  = do { Core Name
nm' <- Name -> DsM (Core Name)
lookupBinder Name
SrcSpanLess (Located Name)
nm
       ; Core Name -> DsM (Core TyVarBndrQ)
repPlainTV Core Name
nm' }
repTyVarBndr (LHsTyVarBndr GhcRn -> Located (SrcSpanLess (LHsTyVarBndr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (KindedTyVar _ (dL->L _ nm) ki))
  = do { Core Name
nm' <- Name -> DsM (Core Name)
lookupBinder Name
SrcSpanLess (Located Name)
nm
       ; Core TypeQ
ki' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ki
       ; Core Name -> Core TypeQ -> DsM (Core TyVarBndrQ)
repKindedTV Core Name
nm' Core TypeQ
ki' }
repTyVarBndr LHsTyVarBndr GhcRn
_ = String -> DsM (Core TyVarBndrQ)
forall a. String -> a
panic String
"repTyVarBndr"

-- represent a type context
--
repLContext :: LHsContext GhcRn -> DsM (Core TH.CxtQ)
repLContext :: LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
ctxt = HsContext GhcRn -> DsM (Core CxtQ)
repContext (LHsContext GhcRn -> SrcSpanLess (LHsContext GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsContext GhcRn
ctxt)

repContext :: HsContext GhcRn -> DsM (Core TH.CxtQ)
repContext :: HsContext GhcRn -> DsM (Core CxtQ)
repContext HsContext GhcRn
ctxt = do Core [TypeQ]
preds <- Name
-> (LHsType GhcRn -> DsM (Core TypeQ))
-> HsContext GhcRn
-> DsM (Core [TypeQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
typeQTyConName LHsType GhcRn -> DsM (Core TypeQ)
repLTy HsContext GhcRn
ctxt
                     Core [TypeQ] -> DsM (Core CxtQ)
repCtxt Core [TypeQ]
preds

repHsSigType :: LHsSigType GhcRn -> DsM (Core TH.TypeQ)
repHsSigType :: HsImplicitBndrs GhcRn (LHsType GhcRn) -> DsM (Core TypeQ)
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 GhcRn]
explicit_tvs, LHsContext GhcRn
ctxt, LHsType GhcRn
ty) <- LHsType GhcRn
-> ([LHsTyVarBndr GhcRn], LHsContext GhcRn, LHsType GhcRn)
forall pass.
LHsType pass
-> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)
splitLHsSigmaTyInvis LHsType GhcRn
body
  = [Name] -> DsM (Core TypeQ) -> DsM (Core TypeQ)
forall a. [Name] -> DsM (Core (Q a)) -> DsM (Core (Q a))
addSimpleTyVarBinds [Name]
XHsIB GhcRn (LHsType GhcRn)
implicit_tvs (DsM (Core TypeQ) -> DsM (Core TypeQ))
-> DsM (Core TypeQ) -> DsM (Core TypeQ)
forall a b. (a -> b) -> a -> b
$
      -- See Note [Don't quantify implicit type variables in quotes]
    [LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core TypeQ)) -> DsM (Core TypeQ)
forall a.
[LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addHsTyVarBinds [LHsTyVarBndr GhcRn]
explicit_tvs ((Core [TyVarBndrQ] -> DsM (Core TypeQ)) -> DsM (Core TypeQ))
-> (Core [TyVarBndrQ] -> DsM (Core TypeQ)) -> DsM (Core TypeQ)
forall a b. (a -> b) -> a -> b
$ \ Core [TyVarBndrQ]
th_explicit_tvs ->
    do { Core CxtQ
th_ctxt <- LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
ctxt
       ; Core TypeQ
th_ty   <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ty
       ; if [LHsTyVarBndr GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr GhcRn]
explicit_tvs Bool -> Bool -> Bool
&& HsContext GhcRn -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LHsContext GhcRn -> SrcSpanLess (LHsContext GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsContext GhcRn
ctxt)
         then Core TypeQ -> DsM (Core TypeQ)
forall (m :: * -> *) a. Monad m => a -> m a
return Core TypeQ
th_ty
         else Core [TyVarBndrQ] -> Core CxtQ -> Core TypeQ -> DsM (Core TypeQ)
repTForall Core [TyVarBndrQ]
th_explicit_tvs Core CxtQ
th_ctxt Core TypeQ
th_ty }
repHsSigType (XHsImplicitBndrs XXHsImplicitBndrs GhcRn (LHsType GhcRn)
nec) = NoExtCon -> DsM (Core TypeQ)
forall a. NoExtCon -> a
noExtCon XXHsImplicitBndrs GhcRn (LHsType GhcRn)
NoExtCon
nec

repHsSigWcType :: LHsSigWcType GhcRn -> DsM (Core TH.TypeQ)
repHsSigWcType :: HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
-> DsM (Core TypeQ)
repHsSigWcType (HsWC { hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body = HsImplicitBndrs GhcRn (LHsType GhcRn)
sig1 })
  = HsImplicitBndrs GhcRn (LHsType GhcRn) -> DsM (Core TypeQ)
repHsSigType HsImplicitBndrs GhcRn (LHsType GhcRn)
sig1
repHsSigWcType (XHsWildCardBndrs XXHsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
nec) = NoExtCon -> DsM (Core TypeQ)
forall a. NoExtCon -> a
noExtCon XXHsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
NoExtCon
nec

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

-- represent a type
repLTy :: LHsType GhcRn -> DsM (Core TH.TypeQ)
repLTy :: LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
ty = HsType GhcRn -> DsM (Core TypeQ)
repTy (LHsType GhcRn -> SrcSpanLess (LHsType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
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 ForallInvis@ or @HsQualTy@.
-- Types headed by visible foralls (which are desugared to ForallVisT) are
-- handled separately in repTy.
repForallT :: HsType GhcRn -> DsM (Core TH.TypeQ)
repForallT :: HsType GhcRn -> DsM (Core TypeQ)
repForallT HsType GhcRn
ty
 | ([LHsTyVarBndr GhcRn]
tvs, LHsContext GhcRn
ctxt, LHsType GhcRn
tau) <- LHsType GhcRn
-> ([LHsTyVarBndr GhcRn], LHsContext GhcRn, LHsType GhcRn)
forall pass.
LHsType pass
-> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)
splitLHsSigmaTyInvis (SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LHsType GhcRn)
HsType GhcRn
ty)
 = [LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core TypeQ)) -> DsM (Core TypeQ)
forall a.
[LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addHsTyVarBinds [LHsTyVarBndr GhcRn]
tvs ((Core [TyVarBndrQ] -> DsM (Core TypeQ)) -> DsM (Core TypeQ))
-> (Core [TyVarBndrQ] -> DsM (Core TypeQ)) -> DsM (Core TypeQ)
forall a b. (a -> b) -> a -> b
$ \Core [TyVarBndrQ]
bndrs ->
   do { Core CxtQ
ctxt1  <- LHsContext GhcRn -> DsM (Core CxtQ)
repLContext LHsContext GhcRn
ctxt
      ; Core TypeQ
tau1   <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
tau
      ; Core [TyVarBndrQ] -> Core CxtQ -> Core TypeQ -> DsM (Core TypeQ)
repTForall Core [TyVarBndrQ]
bndrs Core CxtQ
ctxt1 Core TypeQ
tau1 -- forall a. C a => {...}
      }

repTy :: HsType GhcRn -> DsM (Core TH.TypeQ)
repTy :: HsType GhcRn -> DsM (Core TypeQ)
repTy ty :: HsType GhcRn
ty@(HsForAllTy { hst_fvf :: forall pass. HsType pass -> ForallVisFlag
hst_fvf = ForallVisFlag
fvf, hst_bndrs :: forall pass. HsType pass -> [LHsTyVarBndr pass]
hst_bndrs = [LHsTyVarBndr GhcRn]
tvs, hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcRn
body }) =
  case ForallVisFlag
fvf of
    ForallVisFlag
ForallInvis -> HsType GhcRn -> DsM (Core TypeQ)
repForallT HsType GhcRn
ty
    ForallVisFlag
ForallVis   -> [LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core TypeQ)) -> DsM (Core TypeQ)
forall a.
[LHsTyVarBndr GhcRn]
-> (Core [TyVarBndrQ] -> DsM (Core (Q a))) -> DsM (Core (Q a))
addHsTyVarBinds [LHsTyVarBndr GhcRn]
tvs ((Core [TyVarBndrQ] -> DsM (Core TypeQ)) -> DsM (Core TypeQ))
-> (Core [TyVarBndrQ] -> DsM (Core TypeQ)) -> DsM (Core TypeQ)
forall a b. (a -> b) -> a -> b
$ \Core [TyVarBndrQ]
bndrs ->
                   do Core TypeQ
body1 <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
body
                      Core [TyVarBndrQ] -> Core TypeQ -> DsM (Core TypeQ)
repTForallVis Core [TyVarBndrQ]
bndrs Core TypeQ
body1
repTy ty :: HsType GhcRn
ty@(HsQualTy {}) = HsType GhcRn -> DsM (Core TypeQ)
repForallT HsType GhcRn
ty

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

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

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

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

-- | Represent a type wrapped in a Maybe
repMaybeLTy :: Maybe (LHsKind GhcRn)
            -> DsM (Core (Maybe TH.TypeQ))
repMaybeLTy :: Maybe (LHsType GhcRn) -> DsM (Core (Maybe TypeQ))
repMaybeLTy = Name
-> (LHsType GhcRn -> DsM (Core TypeQ))
-> Maybe (LHsType GhcRn)
-> DsM (Core (Maybe TypeQ))
forall a b.
Name -> (a -> DsM (Core b)) -> Maybe a -> DsM (Core (Maybe b))
repMaybe Name
kindQTyConName LHsType GhcRn -> DsM (Core TypeQ)
repLTy

repRole :: Located (Maybe Role) -> DsM (Core TH.Role)
repRole :: Located (Maybe Role) -> IOEnv (Env DsGblEnv DsLclEnv) (Core Role)
repRole (Located (Maybe Role)
-> Located (SrcSpanLess (Located (Maybe Role)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (Just Nominal))          = Name -> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) (Core Role)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
nominalRName []
repRole (Located (Maybe Role)
-> Located (SrcSpanLess (Located (Maybe Role)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (Just Representational)) = Name -> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) (Core Role)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
representationalRName []
repRole (Located (Maybe Role)
-> Located (SrcSpanLess (Located (Maybe Role)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (Just Phantom))          = Name -> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) (Core Role)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
phantomRName []
repRole (Located (Maybe Role)
-> Located (SrcSpanLess (Located (Maybe Role)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located (Maybe Role))
Nothing)                 = Name -> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) (Core Role)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
inferRName []
repRole Located (Maybe Role)
_ = String -> IOEnv (Env DsGblEnv DsLclEnv) (Core Role)
forall a. String -> a
panic String
"repRole: Impossible Match" -- due to #15884

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

repSplice :: HsSplice GhcRn -> DsM (Core a)
-- See Note [How brackets and nested splices are handled] in TcSplice
-- We return a CoreExpr of any old type; the context should know
repSplice :: HsSplice GhcRn -> DsM (Core a)
repSplice (HsTypedSplice   XTypedSplice GhcRn
_ SpliceDecoration
_ IdP GhcRn
n LHsExpr GhcRn
_) = Name -> DsM (Core a)
forall a. Name -> DsM (Core a)
rep_splice Name
IdP GhcRn
n
repSplice (HsUntypedSplice XUntypedSplice GhcRn
_ SpliceDecoration
_ IdP GhcRn
n LHsExpr GhcRn
_) = Name -> DsM (Core a)
forall a. Name -> DsM (Core a)
rep_splice Name
IdP GhcRn
n
repSplice (HsQuasiQuote XQuasiQuote GhcRn
_ IdP GhcRn
n IdP GhcRn
_ SrcSpan
_ CLabelString
_)  = Name -> DsM (Core a)
forall a. Name -> DsM (Core a)
rep_splice Name
IdP GhcRn
n
repSplice e :: HsSplice GhcRn
e@(HsSpliced {})          = String -> SDoc -> DsM (Core a)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repSplice" (HsSplice GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsSplice GhcRn
e)
repSplice e :: HsSplice GhcRn
e@(HsSplicedT {})         = String -> SDoc -> DsM (Core a)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"repSpliceT" (HsSplice GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsSplice GhcRn
e)
repSplice (XSplice XXSplice GhcRn
nec)             = NoExtCon -> DsM (Core a)
forall a. NoExtCon -> a
noExtCon XXSplice GhcRn
NoExtCon
nec

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

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

repLEs :: [LHsExpr GhcRn] -> DsM (Core [TH.ExpQ])
repLEs :: [LHsExpr GhcRn] -> DsM (Core [ExpQ])
repLEs [LHsExpr GhcRn]
es = Name
-> (LHsExpr GhcRn -> DsM (Core ExpQ))
-> [LHsExpr GhcRn]
-> DsM (Core [ExpQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
expQTyConName LHsExpr GhcRn -> DsM (Core ExpQ)
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 -> DsM (Core TH.ExpQ)
repLE :: LHsExpr GhcRn -> DsM (Core ExpQ)
repLE (LHsExpr GhcRn -> Located (SrcSpanLess (LHsExpr GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (LHsExpr GhcRn)
e) = SrcSpan -> DsM (Core ExpQ) -> DsM (Core ExpQ)
forall a. SrcSpan -> DsM a -> DsM a
putSrcSpanDs SrcSpan
loc (HsExpr GhcRn -> DsM (Core ExpQ)
repE SrcSpanLess (LHsExpr GhcRn)
HsExpr GhcRn
e)

repE :: HsExpr GhcRn -> DsM (Core TH.ExpQ)
repE :: HsExpr GhcRn -> DsM (Core ExpQ)
repE (HsVar XVar GhcRn
_ (Located (IdP GhcRn) -> Located (SrcSpanLess (Located Name))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located Name)
x)) =
  do { Maybe DsMetaVal
mb_val <- Name -> DsM (Maybe DsMetaVal)
dsLookupMetaEnv Name
SrcSpanLess (Located Name)
x
     ; case Maybe DsMetaVal
mb_val of
        Maybe DsMetaVal
Nothing            -> do { Core Name
str <- Name -> DsM (Core Name)
globalVar Name
SrcSpanLess (Located Name)
x
                                 ; Name -> Core Name -> DsM (Core ExpQ)
repVarOrCon Name
SrcSpanLess (Located Name)
x Core Name
str }
        Just (DsBound Id
y)   -> Name -> Core Name -> DsM (Core ExpQ)
repVarOrCon Name
SrcSpanLess (Located Name)
x (Id -> Core Name
coreVar Id
y)
        Just (DsSplice HsExpr GhcTc
e)  -> do { CoreExpr
e' <- HsExpr GhcTc -> DsM CoreExpr
dsExpr HsExpr GhcTc
e
                                 ; Core ExpQ -> DsM (Core ExpQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core ExpQ
forall a. CoreExpr -> Core a
MkC CoreExpr
e') } }
repE (HsIPVar XIPVar GhcRn
_ HsIPName
n) = HsIPName -> DsM (Core String)
rep_implicit_param_name HsIPName
n DsM (Core String)
-> (Core String -> DsM (Core ExpQ)) -> DsM (Core ExpQ)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Core String -> DsM (Core ExpQ)
repImplicitParamVar
repE (HsOverLabel XOverLabel GhcRn
_ Maybe (IdP GhcRn)
_ CLabelString
s) = CLabelString -> DsM (Core ExpQ)
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 -> DsM (Core ExpQ)
repE (XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located Name)
XUnambiguous GhcRn
x))
  Ambiguous{}     -> String -> SDoc -> DsM (Core ExpQ)
forall a. String -> SDoc -> DsM a
notHandled String
"Ambiguous record selectors" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)
  XAmbiguousFieldOcc{} -> String -> SDoc -> DsM (Core ExpQ)
forall a. String -> SDoc -> DsM a
notHandled String
"XAmbiguous 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 -> DsM (Core Lit)
repOverloadedLiteral HsOverLit GhcRn
l; Core Lit -> DsM (Core ExpQ)
repLit Core Lit
a }
repE (HsLit XLitE GhcRn
_ HsLit GhcRn
l)     = do { Core Lit
a <- HsLit GhcRn -> DsM (Core Lit)
repLiteral HsLit GhcRn
l;           Core Lit -> DsM (Core ExpQ)
repLit Core Lit
a }
repE (HsLam XLam GhcRn
_ (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = (Located [LMatch GhcRn (LHsExpr GhcRn)]
-> Located (SrcSpanLess (Located [LMatch GhcRn (LHsExpr GhcRn)]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ [m]) })) = LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core ExpQ)
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 = (Located [LMatch GhcRn (LHsExpr GhcRn)]
-> Located (SrcSpanLess (Located [LMatch GhcRn (LHsExpr GhcRn)]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located [LMatch GhcRn (LHsExpr GhcRn)])
ms) }))
                   = do { [Core MatchQ]
ms' <- (LMatch GhcRn (LHsExpr GhcRn)
 -> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ))
-> [LMatch GhcRn (LHsExpr GhcRn)]
-> IOEnv (Env DsGblEnv DsLclEnv) [Core MatchQ]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LMatch GhcRn (LHsExpr GhcRn)
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
repMatchTup [LMatch GhcRn (LHsExpr GhcRn)]
SrcSpanLess (Located [LMatch GhcRn (LHsExpr GhcRn)])
ms
                        ; Core [MatchQ]
core_ms <- Name -> [Core MatchQ] -> DsM (Core [MatchQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
matchQTyConName [Core MatchQ]
ms'
                        ; Core [MatchQ] -> DsM (Core ExpQ)
repLamCase Core [MatchQ]
core_ms }
repE (HsApp XApp GhcRn
_ LHsExpr GhcRn
x LHsExpr GhcRn
y)   = do {Core ExpQ
a <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
x; Core ExpQ
b <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
y; Core ExpQ -> Core ExpQ -> DsM (Core ExpQ)
repApp Core ExpQ
a Core ExpQ
b}
repE (HsAppType XAppTypeE GhcRn
_ LHsExpr GhcRn
e LHsWcType (NoGhcTc GhcRn)
t) = do { Core ExpQ
a <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e
                            ; Core TypeQ
s <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy (HsWildCardBndrs GhcRn (LHsType GhcRn) -> LHsType GhcRn
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcRn)
HsWildCardBndrs GhcRn (LHsType GhcRn)
t)
                            ; Core ExpQ -> Core TypeQ -> DsM (Core ExpQ)
repAppType Core ExpQ
a Core TypeQ
s }

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

-- FIXME: I haven't got the types here right yet
repE e :: HsExpr GhcRn
e@(HsDo XDo GhcRn
_ HsStmtContext Name
ctxt (Located [ExprLStmt GhcRn]
-> Located (SrcSpanLess (Located [ExprLStmt GhcRn]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located [ExprLStmt GhcRn])
sts))
 | case HsStmtContext Name
ctxt of { HsStmtContext Name
DoExpr -> Bool
True; HsStmtContext Name
GhciStmtCtxt -> Bool
True; HsStmtContext Name
_ -> Bool
False }
 = do { ([GenSymBind]
ss,[Core StmtQ]
zs) <- [ExprLStmt GhcRn] -> DsM ([GenSymBind], [Core StmtQ])
repLSts [ExprLStmt GhcRn]
SrcSpanLess (Located [ExprLStmt GhcRn])
sts;
        Core ExpQ
e'      <- Core [StmtQ] -> DsM (Core ExpQ)
repDoE ([Core StmtQ] -> Core [StmtQ]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core StmtQ]
zs);
        [GenSymBind] -> Core ExpQ -> DsM (Core ExpQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core ExpQ
e' }

 | HsStmtContext Name
ListComp <- HsStmtContext Name
ctxt
 = do { ([GenSymBind]
ss,[Core StmtQ]
zs) <- [ExprLStmt GhcRn] -> DsM ([GenSymBind], [Core StmtQ])
repLSts [ExprLStmt GhcRn]
SrcSpanLess (Located [ExprLStmt GhcRn])
sts;
        Core ExpQ
e'      <- Core [StmtQ] -> DsM (Core ExpQ)
repComp ([Core StmtQ] -> Core [StmtQ]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core StmtQ]
zs);
        [GenSymBind] -> Core ExpQ -> DsM (Core ExpQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core ExpQ
e' }

 | HsStmtContext Name
MDoExpr <- HsStmtContext Name
ctxt
 = do { ([GenSymBind]
ss,[Core StmtQ]
zs) <- [ExprLStmt GhcRn] -> DsM ([GenSymBind], [Core StmtQ])
repLSts [ExprLStmt GhcRn]
SrcSpanLess (Located [ExprLStmt GhcRn])
sts;
        Core ExpQ
e'      <- Core [StmtQ] -> DsM (Core ExpQ)
repMDoE ([Core StmtQ] -> Core [StmtQ]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core StmtQ]
zs);
        [GenSymBind] -> Core ExpQ -> DsM (Core ExpQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core ExpQ
e' }

  | Bool
otherwise
  = String -> SDoc -> DsM (Core ExpQ)
forall a. String -> SDoc -> DsM 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 [ExpQ]
xs <- [LHsExpr GhcRn] -> DsM (Core [ExpQ])
repLEs [LHsExpr GhcRn]
es; Core [ExpQ] -> DsM (Core ExpQ)
repListExp Core [ExpQ]
xs }
repE (ExplicitTuple XExplicitTuple GhcRn
_ [LHsTupArg GhcRn]
es Boxity
boxity) =
  let tupArgToCoreExp :: LHsTupArg GhcRn -> DsM (Core (Maybe TH.ExpQ))
      tupArgToCoreExp :: LHsTupArg GhcRn -> DsM (Core (Maybe ExpQ))
tupArgToCoreExp LHsTupArg GhcRn
a
        | L SrcSpan
_ (Present _ e) <- LHsTupArg GhcRn
-> GenLocated SrcSpan (SrcSpanLess (LHsTupArg GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL LHsTupArg GhcRn
a = do { Core ExpQ
e' <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e
                                         ; Name -> Core ExpQ -> DsM (Core (Maybe ExpQ))
forall a. Name -> Core a -> DsM (Core (Maybe a))
coreJust Name
expQTyConName Core ExpQ
e' }
        | Bool
otherwise = Name -> DsM (Core (Maybe ExpQ))
forall a. Name -> DsM (Core (Maybe a))
coreNothing Name
expQTyConName

  in do { [Core (Maybe ExpQ)]
args <- (LHsTupArg GhcRn -> DsM (Core (Maybe ExpQ)))
-> [LHsTupArg GhcRn]
-> IOEnv (Env DsGblEnv DsLclEnv) [Core (Maybe ExpQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsTupArg GhcRn -> DsM (Core (Maybe ExpQ))
tupArgToCoreExp [LHsTupArg GhcRn]
es
        ; Type
expQTy <- Name -> DsM Type
lookupType Name
expQTyConName
        ; let maybeExpQTy :: Type
maybeExpQTy = TyCon -> [Type] -> Type
mkTyConApp TyCon
maybeTyCon [Type
expQTy]
              listArg :: Core [Maybe ExpQ]
listArg = Type -> [Core (Maybe ExpQ)] -> Core [Maybe ExpQ]
forall a. Type -> [Core a] -> Core [a]
coreList' Type
maybeExpQTy [Core (Maybe ExpQ)]
args
        ; if Boxity -> Bool
isBoxed Boxity
boxity
          then Core [Maybe ExpQ] -> DsM (Core ExpQ)
repTup Core [Maybe ExpQ]
listArg
          else Core [Maybe ExpQ] -> DsM (Core ExpQ)
repUnboxedTup Core [Maybe ExpQ]
listArg }

repE (ExplicitSum XExplicitSum GhcRn
_ Int
alt Int
arity LHsExpr GhcRn
e)
 = do { Core ExpQ
e1 <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e
      ; Core ExpQ -> Int -> Int -> DsM (Core ExpQ)
repUnboxedSum Core ExpQ
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 -> DsM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
c;
        Core [Q FieldExp]
fs <- HsRecordBinds GhcRn -> DsM (Core [Q FieldExp])
repFields HsRecordBinds GhcRn
flds;
        Core Name -> Core [Q FieldExp] -> DsM (Core ExpQ)
repRecCon Core Name
x Core [Q 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 ExpQ
x <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e;
        Core [Q FieldExp]
fs <- [LHsRecUpdField GhcRn] -> DsM (Core [Q FieldExp])
repUpdFields [LHsRecUpdField GhcRn]
flds;
        Core ExpQ -> Core [Q FieldExp] -> DsM (Core ExpQ)
repRecUpd Core ExpQ
x Core [Q FieldExp]
fs }

repE (ExprWithTySig XExprWithTySig GhcRn
_ LHsExpr GhcRn
e LHsSigWcType (NoGhcTc GhcRn)
ty)
  = do { Core ExpQ
e1 <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e
       ; Core TypeQ
t1 <- HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
-> DsM (Core TypeQ)
repHsSigWcType LHsSigWcType (NoGhcTc GhcRn)
HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
ty
       ; Core ExpQ -> Core TypeQ -> DsM (Core ExpQ)
repSigExp Core ExpQ
e1 Core TypeQ
t1 }

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

repE (HsSpliceE XSpliceE GhcRn
_ HsSplice GhcRn
splice)  = HsSplice GhcRn -> DsM (Core ExpQ)
forall a. HsSplice GhcRn -> DsM (Core a)
repSplice HsSplice GhcRn
splice
repE (HsStatic XStatic GhcRn
_ LHsExpr GhcRn
e)        = LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e DsM (Core ExpQ)
-> (Core ExpQ -> DsM (Core ExpQ)) -> DsM (Core ExpQ)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
staticEName ([CoreExpr] -> DsM (Core ExpQ))
-> (Core ExpQ -> [CoreExpr]) -> Core ExpQ -> DsM (Core ExpQ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoreExpr -> [CoreExpr] -> [CoreExpr]
forall a. a -> [a] -> [a]
:[]) (CoreExpr -> [CoreExpr])
-> (Core ExpQ -> CoreExpr) -> Core ExpQ -> [CoreExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Core ExpQ -> CoreExpr
forall a. Core a -> CoreExpr
unC
repE (HsUnboundVar XUnboundVar GhcRn
_ UnboundVar
uv)   = do
                               Core String
occ   <- OccName -> DsM (Core String)
occNameLit (UnboundVar -> OccName
unboundVarOcc UnboundVar
uv)
                               Core Name
sname <- Core String -> DsM (Core Name)
repNameS Core String
occ
                               Core Name -> DsM (Core ExpQ)
repUnboundVar Core Name
sname

repE e :: HsExpr GhcRn
e@(HsCoreAnn {})      = String -> SDoc -> DsM (Core ExpQ)
forall a. String -> SDoc -> DsM a
notHandled String
"Core annotations" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)
repE e :: HsExpr GhcRn
e@(HsSCC {})          = String -> SDoc -> DsM (Core ExpQ)
forall a. String -> SDoc -> DsM a
notHandled String
"Cost centres" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)
repE e :: HsExpr GhcRn
e@(HsTickPragma {})   = String -> SDoc -> DsM (Core ExpQ)
forall a. String -> SDoc -> DsM a
notHandled String
"Tick Pragma" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)
repE HsExpr GhcRn
e                     = String -> SDoc -> DsM (Core ExpQ)
forall a. String -> SDoc -> DsM a
notHandled String
"Expression form" (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
e)

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

repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.MatchQ)
repMatchTup :: LMatch GhcRn (LHsExpr GhcRn)
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
repMatchTup (LMatch GhcRn (LHsExpr GhcRn)
-> Located (SrcSpanLess (LMatch GhcRn (LHsExpr GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (Match { m_pats = [p]
                            , m_grhss = GRHSs _ guards (dL->L _ wheres) })) =
  do { [GenSymBind]
ss1 <- [Name] -> DsM [GenSymBind]
mkGenSyms (LPat GhcRn -> [IdP GhcRn]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat GhcRn
p)
     ; [GenSymBind]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss1 (IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
 -> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
forall a b. (a -> b) -> a -> b
$ do {
     ; Core PatQ
p1 <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p
     ; ([GenSymBind]
ss2,Core [DecQ]
ds) <- HsLocalBinds GhcRn -> DsM ([GenSymBind], Core [DecQ])
repBinds SrcSpanLess (LHsLocalBinds GhcRn)
HsLocalBinds GhcRn
wheres
     ; [GenSymBind]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss2 (IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
 -> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
forall a b. (a -> b) -> a -> b
$ do {
     ; Core BodyQ
gs    <- [LGRHS GhcRn (LHsExpr GhcRn)] -> DsM (Core BodyQ)
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
guards
     ; Core MatchQ
match <- Core PatQ
-> Core BodyQ
-> Core [DecQ]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
repMatch Core PatQ
p1 Core BodyQ
gs Core [DecQ]
ds
     ; [GenSymBind]
-> Core MatchQ -> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2) Core MatchQ
match }}}
repMatchTup LMatch GhcRn (LHsExpr GhcRn)
_ = String -> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
forall a. String -> a
panic String
"repMatchTup: case alt with more than one arg"

repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ClauseQ)
repClauseTup :: LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core ClauseQ)
repClauseTup (LMatch GhcRn (LHsExpr GhcRn)
-> Located (SrcSpanLess (LMatch GhcRn (LHsExpr GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (Match { m_pats = ps
                             , m_grhss = GRHSs _ guards (dL->L _ wheres) })) =
  do { [GenSymBind]
ss1 <- [Name] -> DsM [GenSymBind]
mkGenSyms ([LPat GhcRn] -> [IdP GhcRn]
forall (p :: Pass). [LPat (GhcPass p)] -> [IdP (GhcPass p)]
collectPatsBinders [LPat GhcRn]
ps)
     ; [GenSymBind] -> DsM (Core ClauseQ) -> DsM (Core ClauseQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss1 (DsM (Core ClauseQ) -> DsM (Core ClauseQ))
-> DsM (Core ClauseQ) -> DsM (Core ClauseQ)
forall a b. (a -> b) -> a -> b
$ do {
       Core [PatQ]
ps1 <- [LPat GhcRn] -> DsM (Core [PatQ])
repLPs [LPat GhcRn]
ps
     ; ([GenSymBind]
ss2,Core [DecQ]
ds) <- HsLocalBinds GhcRn -> DsM ([GenSymBind], Core [DecQ])
repBinds SrcSpanLess (LHsLocalBinds GhcRn)
HsLocalBinds GhcRn
wheres
     ; [GenSymBind] -> DsM (Core ClauseQ) -> DsM (Core ClauseQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss2 (DsM (Core ClauseQ) -> DsM (Core ClauseQ))
-> DsM (Core ClauseQ) -> DsM (Core ClauseQ)
forall a b. (a -> b) -> a -> b
$ do {
       Core BodyQ
gs <- [LGRHS GhcRn (LHsExpr GhcRn)] -> DsM (Core BodyQ)
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
guards
     ; Core ClauseQ
clause <- Core [PatQ] -> Core BodyQ -> Core [DecQ] -> DsM (Core ClauseQ)
repClause Core [PatQ]
ps1 Core BodyQ
gs Core [DecQ]
ds
     ; [GenSymBind] -> Core ClauseQ -> DsM (Core ClauseQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2) Core ClauseQ
clause }}}
repClauseTup (LMatch GhcRn (LHsExpr GhcRn)
-> Located (SrcSpanLess (LMatch GhcRn (LHsExpr GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (Match _ _ _ (XGRHSs nec))) = NoExtCon -> DsM (Core ClauseQ)
forall a. NoExtCon -> a
noExtCon XXGRHSs GhcRn (LHsExpr GhcRn)
NoExtCon
nec
repClauseTup LMatch GhcRn (LHsExpr GhcRn)
_ = String -> DsM (Core ClauseQ)
forall a. String -> a
panic String
"repClauseTup"

repGuards ::  [LGRHS GhcRn (LHsExpr GhcRn)] ->  DsM (Core TH.BodyQ)
repGuards :: [LGRHS GhcRn (LHsExpr GhcRn)] -> DsM (Core BodyQ)
repGuards [LGRHS GhcRn (LHsExpr GhcRn)
-> Located (SrcSpanLess (LGRHS GhcRn (LHsExpr GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (GRHS _ [] e)]
  = do {Core ExpQ
a <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e; Core ExpQ -> DsM (Core BodyQ)
repNormal Core ExpQ
a }
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
other
  = do { [([GenSymBind], Core (Q (Guard, Exp)))]
zs <- (LGRHS GhcRn (LHsExpr GhcRn)
 -> IOEnv
      (Env DsGblEnv DsLclEnv) ([GenSymBind], Core (Q (Guard, Exp))))
-> [LGRHS GhcRn (LHsExpr GhcRn)]
-> IOEnv
     (Env DsGblEnv DsLclEnv) [([GenSymBind], Core (Q (Guard, Exp)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LGRHS GhcRn (LHsExpr GhcRn)
-> IOEnv
     (Env DsGblEnv DsLclEnv) ([GenSymBind], Core (Q (Guard, Exp)))
repLGRHS [LGRHS GhcRn (LHsExpr GhcRn)]
other
       ; let ([[GenSymBind]]
xs, [Core (Q (Guard, Exp))]
ys) = [([GenSymBind], Core (Q (Guard, Exp)))]
-> ([[GenSymBind]], [Core (Q (Guard, Exp))])
forall a b. [(a, b)] -> ([a], [b])
unzip [([GenSymBind], Core (Q (Guard, Exp)))]
zs
       ; Core BodyQ
gd <- Core [Q (Guard, Exp)] -> DsM (Core BodyQ)
repGuarded ([Core (Q (Guard, Exp))] -> Core [Q (Guard, Exp)]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core (Q (Guard, Exp))]
ys)
       ; [GenSymBind] -> Core BodyQ -> DsM (Core BodyQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms ([[GenSymBind]] -> [GenSymBind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenSymBind]]
xs) Core BodyQ
gd }

repLGRHS :: LGRHS GhcRn (LHsExpr GhcRn)
         -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
repLGRHS :: LGRHS GhcRn (LHsExpr GhcRn)
-> IOEnv
     (Env DsGblEnv DsLclEnv) ([GenSymBind], Core (Q (Guard, Exp)))
repLGRHS (LGRHS GhcRn (LHsExpr GhcRn)
-> Located (SrcSpanLess (LGRHS GhcRn (LHsExpr GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (GRHS _ [dL->L _ (BodyStmt _ e1 _ _)] e2))
  = do { Core (Q (Guard, Exp))
guarded <- LHsExpr GhcRn -> LHsExpr GhcRn -> DsM (Core (Q (Guard, Exp)))
repLNormalGE LHsExpr GhcRn
e1 LHsExpr GhcRn
e2
       ; ([GenSymBind], Core (Q (Guard, Exp)))
-> IOEnv
     (Env DsGblEnv DsLclEnv) ([GenSymBind], Core (Q (Guard, Exp)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Core (Q (Guard, Exp))
guarded) }
repLGRHS (LGRHS GhcRn (LHsExpr GhcRn)
-> Located (SrcSpanLess (LGRHS GhcRn (LHsExpr GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (GRHS _ ss rhs))
  = do { ([GenSymBind]
gs, [Core StmtQ]
ss') <- [ExprLStmt GhcRn] -> DsM ([GenSymBind], [Core StmtQ])
repLSts [ExprLStmt GhcRn]
ss
       ; Core ExpQ
rhs' <- [GenSymBind] -> DsM (Core ExpQ) -> DsM (Core ExpQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
gs (DsM (Core ExpQ) -> DsM (Core ExpQ))
-> DsM (Core ExpQ) -> DsM (Core ExpQ)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
rhs
       ; Core (Q (Guard, Exp))
guarded <- Core [StmtQ] -> Core ExpQ -> DsM (Core (Q (Guard, Exp)))
repPatGE ([Core StmtQ] -> Core [StmtQ]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core StmtQ]
ss') Core ExpQ
rhs'
       ; ([GenSymBind], Core (Q (Guard, Exp)))
-> IOEnv
     (Env DsGblEnv DsLclEnv) ([GenSymBind], Core (Q (Guard, Exp)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
gs, Core (Q (Guard, Exp))
guarded) }
repLGRHS LGRHS GhcRn (LHsExpr GhcRn)
_ = String
-> IOEnv
     (Env DsGblEnv DsLclEnv) ([GenSymBind], Core (Q (Guard, Exp)))
forall a. String -> a
panic String
"repLGRHS"

repFields :: HsRecordBinds GhcRn -> DsM (Core [TH.Q TH.FieldExp])
repFields :: HsRecordBinds GhcRn -> DsM (Core [Q 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) -> DsM (Core (Q FieldExp)))
-> [LHsRecField GhcRn (LHsExpr GhcRn)]
-> DsM (Core [Q FieldExp])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
fieldExpQTyConName LHsRecField GhcRn (LHsExpr GhcRn) -> DsM (Core (Q FieldExp))
rep_fld [LHsRecField GhcRn (LHsExpr GhcRn)]
flds
  where
    rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn)
            -> DsM (Core (TH.Q TH.FieldExp))
    rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn) -> DsM (Core (Q FieldExp))
rep_fld (LHsRecField GhcRn (LHsExpr GhcRn)
-> Located (SrcSpanLess (LHsRecField GhcRn (LHsExpr GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LHsRecField GhcRn (LHsExpr GhcRn))
fld) = do { Core Name
fn <- Located Name -> DsM (Core Name)
lookupLOcc (HsRecField GhcRn (LHsExpr GhcRn) -> Located (XCFieldOcc GhcRn)
forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel SrcSpanLess (LHsRecField GhcRn (LHsExpr GhcRn))
HsRecField GhcRn (LHsExpr GhcRn)
fld)
                               ; Core ExpQ
e  <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE (HsRecField GhcRn (LHsExpr GhcRn) -> LHsExpr GhcRn
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg SrcSpanLess (LHsRecField GhcRn (LHsExpr GhcRn))
HsRecField GhcRn (LHsExpr GhcRn)
fld)
                               ; Core Name -> Core ExpQ -> DsM (Core (Q FieldExp))
repFieldExp Core Name
fn Core ExpQ
e }

repUpdFields :: [LHsRecUpdField GhcRn] -> DsM (Core [TH.Q TH.FieldExp])
repUpdFields :: [LHsRecUpdField GhcRn] -> DsM (Core [Q FieldExp])
repUpdFields = Name
-> (LHsRecUpdField GhcRn -> DsM (Core (Q FieldExp)))
-> [LHsRecUpdField GhcRn]
-> DsM (Core [Q FieldExp])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
fieldExpQTyConName LHsRecUpdField GhcRn -> DsM (Core (Q FieldExp))
rep_fld
  where
    rep_fld :: LHsRecUpdField GhcRn -> DsM (Core (TH.Q TH.FieldExp))
    rep_fld :: LHsRecUpdField GhcRn -> DsM (Core (Q FieldExp))
rep_fld (LHsRecUpdField GhcRn
-> Located (SrcSpanLess (LHsRecUpdField GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (LHsRecUpdField GhcRn)
fld) = case Located (AmbiguousFieldOcc GhcRn)
-> SrcSpanLess (Located (AmbiguousFieldOcc GhcRn))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
-> Located (AmbiguousFieldOcc GhcRn)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl SrcSpanLess (LHsRecUpdField GhcRn)
HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
fld) of
      Unambiguous sel_name _ -> do { Core Name
fn <- Located Name -> DsM (Core Name)
lookupLOcc (SrcSpan -> SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (Located Name)
XUnambiguous GhcRn
sel_name)
                                   ; Core ExpQ
e  <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE (HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
-> LHsExpr GhcRn
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg SrcSpanLess (LHsRecUpdField GhcRn)
HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
fld)
                                   ; Core Name -> Core ExpQ -> DsM (Core (Q FieldExp))
repFieldExp Core Name
fn Core ExpQ
e }
      SrcSpanLess (Located (AmbiguousFieldOcc GhcRn))
_                      -> String -> SDoc -> DsM (Core (Q FieldExp))
forall a. String -> SDoc -> DsM a
notHandled String
"Ambiguous record updates" (HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpanLess (LHsRecUpdField GhcRn)
HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr 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 shaddow, 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 [ 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)] -> DsM ([GenSymBind], [Core TH.StmtQ])
repLSts :: [ExprLStmt GhcRn] -> DsM ([GenSymBind], [Core StmtQ])
repLSts [ExprLStmt GhcRn]
stmts = [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core StmtQ])
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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [ExprLStmt GhcRn]
stmts)

repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core TH.StmtQ])
repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core StmtQ])
repSts (BindStmt XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
_ LPat GhcRn
p LHsExpr GhcRn
e SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_ : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
   do { Core ExpQ
e2 <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e
      ; [GenSymBind]
ss1 <- [Name] -> DsM [GenSymBind]
mkGenSyms (LPat GhcRn -> [IdP GhcRn]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat GhcRn
p)
      ; [GenSymBind]
-> DsM ([GenSymBind], [Core StmtQ])
-> DsM ([GenSymBind], [Core StmtQ])
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss1 (DsM ([GenSymBind], [Core StmtQ])
 -> DsM ([GenSymBind], [Core StmtQ]))
-> DsM ([GenSymBind], [Core StmtQ])
-> DsM ([GenSymBind], [Core StmtQ])
forall a b. (a -> b) -> a -> b
$ do {
      ; Core PatQ
p1 <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p;
      ; ([GenSymBind]
ss2,[Core StmtQ]
zs) <- [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core StmtQ])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss
      ; Core StmtQ
z <- Core PatQ -> Core ExpQ -> DsM (Core StmtQ)
repBindSt Core PatQ
p1 Core ExpQ
e2
      ; ([GenSymBind], [Core StmtQ]) -> DsM ([GenSymBind], [Core StmtQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core StmtQ
z Core StmtQ -> [Core StmtQ] -> [Core StmtQ]
forall a. a -> [a] -> [a]
: [Core StmtQ]
zs) }}
repSts (LetStmt XLetStmt GhcRn GhcRn (LHsExpr GhcRn)
_ (LHsLocalBinds GhcRn -> Located (SrcSpanLess (LHsLocalBinds GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LHsLocalBinds GhcRn)
bs) : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
   do { ([GenSymBind]
ss1,Core [DecQ]
ds) <- HsLocalBinds GhcRn -> DsM ([GenSymBind], Core [DecQ])
repBinds SrcSpanLess (LHsLocalBinds GhcRn)
HsLocalBinds GhcRn
bs
      ; Core StmtQ
z <- Core [DecQ] -> DsM (Core StmtQ)
repLetSt Core [DecQ]
ds
      ; ([GenSymBind]
ss2,[Core StmtQ]
zs) <- [GenSymBind]
-> DsM ([GenSymBind], [Core StmtQ])
-> DsM ([GenSymBind], [Core StmtQ])
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss1 ([Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core StmtQ])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss)
      ; ([GenSymBind], [Core StmtQ]) -> DsM ([GenSymBind], [Core StmtQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core StmtQ
z Core StmtQ -> [Core StmtQ] -> [Core StmtQ]
forall a. a -> [a] -> [a]
: [Core StmtQ]
zs) }
repSts (BodyStmt XBodyStmt GhcRn GhcRn (LHsExpr GhcRn)
_ LHsExpr GhcRn
e SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_ : [Stmt GhcRn (LHsExpr GhcRn)]
ss) =
   do { Core ExpQ
e2 <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e
      ; Core StmtQ
z <- Core ExpQ -> DsM (Core StmtQ)
repNoBindSt Core ExpQ
e2
      ; ([GenSymBind]
ss2,[Core StmtQ]
zs) <- [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core StmtQ])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss
      ; ([GenSymBind], [Core StmtQ]) -> DsM ([GenSymBind], [Core StmtQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss2, Core StmtQ
z Core StmtQ -> [Core StmtQ] -> [Core StmtQ]
forall a. a -> [a] -> [a]
: [Core StmtQ]
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 [StmtQ]]
stmt_blocks1) <- (ParStmtBlock GhcRn GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) ([GenSymBind], Core [StmtQ]))
-> [ParStmtBlock GhcRn GhcRn]
-> IOEnv (Env DsGblEnv DsLclEnv) ([[GenSymBind]], [Core [StmtQ]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM ParStmtBlock GhcRn GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) ([GenSymBind], Core [StmtQ])
rep_stmt_block [ParStmtBlock GhcRn GhcRn]
stmt_blocks
      ; let stmt_blocks2 :: Core [[StmtQ]]
stmt_blocks2 = [Core [StmtQ]] -> Core [[StmtQ]]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core [StmtQ]]
stmt_blocks1
            ss1 :: [GenSymBind]
ss1 = [[GenSymBind]] -> [GenSymBind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GenSymBind]]
ss_s
      ; Core StmtQ
z <- Core [[StmtQ]] -> DsM (Core StmtQ)
repParSt Core [[StmtQ]]
stmt_blocks2
      ; ([GenSymBind]
ss2, [Core StmtQ]
zs) <- [GenSymBind]
-> DsM ([GenSymBind], [Core StmtQ])
-> DsM ([GenSymBind], [Core StmtQ])
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss1 ([Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core StmtQ])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss)
      ; ([GenSymBind], [Core StmtQ]) -> DsM ([GenSymBind], [Core StmtQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core StmtQ
z Core StmtQ -> [Core StmtQ] -> [Core StmtQ]
forall a. a -> [a] -> [a]
: [Core StmtQ]
zs) }
   where
     rep_stmt_block :: ParStmtBlock GhcRn GhcRn
                    -> DsM ([GenSymBind], Core [TH.StmtQ])
     rep_stmt_block :: ParStmtBlock GhcRn GhcRn
-> IOEnv (Env DsGblEnv DsLclEnv) ([GenSymBind], Core [StmtQ])
rep_stmt_block (ParStmtBlock XParStmtBlock GhcRn GhcRn
_ [ExprLStmt GhcRn]
stmts [IdP GhcRn]
_ SyntaxExpr GhcRn
_) =
       do { ([GenSymBind]
ss1, [Core StmtQ]
zs) <- [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core StmtQ])
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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [ExprLStmt GhcRn]
stmts)
          ; Core [StmtQ]
zs1 <- Name -> [Core StmtQ] -> DsM (Core [StmtQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
stmtQTyConName [Core StmtQ]
zs
          ; ([GenSymBind], Core [StmtQ])
-> IOEnv (Env DsGblEnv DsLclEnv) ([GenSymBind], Core [StmtQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1, Core [StmtQ]
zs1) }
     rep_stmt_block (XParStmtBlock XXParStmtBlock GhcRn GhcRn
nec) = NoExtCon
-> IOEnv (Env DsGblEnv DsLclEnv) ([GenSymBind], Core [StmtQ])
forall a. NoExtCon -> a
noExtCon XXParStmtBlock GhcRn GhcRn
NoExtCon
nec
repSts [LastStmt XLastStmt GhcRn GhcRn (LHsExpr GhcRn)
_ LHsExpr GhcRn
e Bool
_ SyntaxExpr GhcRn
_]
  = do { Core ExpQ
e2 <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e
       ; Core StmtQ
z <- Core ExpQ -> DsM (Core StmtQ)
repNoBindSt Core ExpQ
e2
       ; ([GenSymBind], [Core StmtQ]) -> DsM ([GenSymBind], [Core StmtQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Core StmtQ
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.
[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] -> DsM [GenSymBind]
mkGenSyms [Name]
[IdP GhcRn]
binders
       -- Bring all of binders in the recursive group into scope for the
       -- whole group.
       ; ([GenSymBind]
ss1_other,[Core StmtQ]
rss) <- [GenSymBind]
-> DsM ([GenSymBind], [Core StmtQ])
-> DsM ([GenSymBind], [Core StmtQ])
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss1 (DsM ([GenSymBind], [Core StmtQ])
 -> DsM ([GenSymBind], [Core StmtQ]))
-> DsM ([GenSymBind], [Core StmtQ])
-> DsM ([GenSymBind], [Core StmtQ])
forall a b. (a -> b) -> a -> b
$ [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core StmtQ])
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 a. HasSrcSpan a => a -> SrcSpanLess a
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 StmtQ
z <- Core [StmtQ] -> DsM (Core StmtQ)
repRecSt ([Core StmtQ] -> Core [StmtQ]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core StmtQ]
rss)
       ; ([GenSymBind]
ss2,[Core StmtQ]
zs) <- [GenSymBind]
-> DsM ([GenSymBind], [Core StmtQ])
-> DsM ([GenSymBind], [Core StmtQ])
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss1 ([Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core StmtQ])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
ss)
       ; ([GenSymBind], [Core StmtQ]) -> DsM ([GenSymBind], [Core StmtQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss1[GenSymBind] -> [GenSymBind] -> [GenSymBind]
forall a. [a] -> [a] -> [a]
++[GenSymBind]
ss2, Core StmtQ
z Core StmtQ -> [Core StmtQ] -> [Core StmtQ]
forall a. a -> [a] -> [a]
: [Core StmtQ]
zs) }
repSts []    = ([GenSymBind], [Core StmtQ]) -> DsM ([GenSymBind], [Core StmtQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
repSts [Stmt GhcRn (LHsExpr GhcRn)]
other = String -> SDoc -> DsM ([GenSymBind], [Core StmtQ])
forall a. String -> SDoc -> DsM 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 -> DsM ([GenSymBind], Core [TH.DecQ])
repBinds :: HsLocalBinds GhcRn -> DsM ([GenSymBind], Core [DecQ])
repBinds (EmptyLocalBinds XEmptyLocalBinds GhcRn GhcRn
_)
  = do  { Core [DecQ]
core_list <- Name -> [Core DecQ] -> DsM (Core [DecQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
decQTyConName []
        ; ([GenSymBind], Core [DecQ]) -> DsM ([GenSymBind], Core [DecQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Core [DecQ]
core_list) }

repBinds (HsIPBinds XHsIPBinds GhcRn GhcRn
_ (IPBinds XIPBinds GhcRn
_ [LIPBind GhcRn]
decs))
 = do   { [(SrcSpan, Core DecQ)]
ips <- (LIPBind GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LIPBind GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LIPBind GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_implicit_param_bind [LIPBind GhcRn]
decs
        ; Core [DecQ]
core_list <- Name -> [Core DecQ] -> DsM (Core [DecQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
decQTyConName
                                ([(SrcSpan, Core DecQ)] -> [Core DecQ]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core DecQ)] -> [(SrcSpan, Core DecQ)]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc [(SrcSpan, Core DecQ)]
ips))
        ; ([GenSymBind], Core [DecQ]) -> DsM ([GenSymBind], Core [DecQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Core [DecQ]
core_list)
        }

repBinds b :: HsLocalBinds GhcRn
b@(HsIPBinds XHsIPBinds GhcRn GhcRn
_ XHsIPBinds {})
 = String -> SDoc -> DsM ([GenSymBind], Core [DecQ])
forall a. String -> SDoc -> DsM a
notHandled String
"Implicit parameter binds extension" (HsLocalBinds GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLocalBinds GhcRn
b)

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).
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 bindings]
        ; [GenSymBind]
ss        <- [Name] -> DsM [GenSymBind]
mkGenSyms [Name]
bndrs
        ; [(SrcSpan, Core DecQ)]
prs       <- [GenSymBind]
-> DsM [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss (HsValBinds GhcRn -> DsM [(SrcSpan, Core DecQ)]
rep_val_binds HsValBinds GhcRn
decs)
        ; Core [DecQ]
core_list <- Name -> [Core DecQ] -> DsM (Core [DecQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
decQTyConName
                                ([(SrcSpan, Core DecQ)] -> [Core DecQ]
forall a b. [(a, b)] -> [b]
de_loc ([(SrcSpan, Core DecQ)] -> [(SrcSpan, Core DecQ)]
forall a. [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc [(SrcSpan, Core DecQ)]
prs))
        ; ([GenSymBind], Core [DecQ]) -> DsM ([GenSymBind], Core [DecQ])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind]
ss, Core [DecQ]
core_list) }
repBinds b :: HsLocalBinds GhcRn
b@(XHsLocalBindsLR {}) = String -> SDoc -> DsM ([GenSymBind], Core [DecQ])
forall a. String -> SDoc -> DsM a
notHandled String
"Local binds extensions" (HsLocalBinds GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLocalBinds GhcRn
b)

rep_implicit_param_bind :: LIPBind GhcRn -> DsM (SrcSpan, Core TH.DecQ)
rep_implicit_param_bind :: LIPBind GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_implicit_param_bind (LIPBind GhcRn -> Located (SrcSpanLess (LIPBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (IPBind _ ename (dL->L _ rhs)))
 = do { Core String
name <- case Either (Located HsIPName) (IdP GhcRn)
ename of
                    Left (Located HsIPName -> Located (SrcSpanLess (Located HsIPName))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located HsIPName)
n) -> HsIPName -> DsM (Core String)
rep_implicit_param_name SrcSpanLess (Located HsIPName)
HsIPName
n
                    Right IdP GhcRn
_ ->
                        String -> DsM (Core String)
forall a. String -> a
panic String
"rep_implicit_param_bind: post typechecking"
      ; Core ExpQ
rhs' <- HsExpr GhcRn -> DsM (Core ExpQ)
repE SrcSpanLess (LHsExpr GhcRn)
HsExpr GhcRn
rhs
      ; Core DecQ
ipb <- Core String -> Core ExpQ -> DsM (Core DecQ)
repImplicitParamBind Core String
name Core ExpQ
rhs'
      ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
ipb) }
rep_implicit_param_bind (LIPBind GhcRn -> Located (SrcSpanLess (LIPBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ b :: SrcSpanLess (LIPBind GhcRn)
b@(XIPBind _))
 = String
-> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> SDoc -> DsM a
notHandled String
"Implicit parameter bind extension" (IPBind GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpanLess (LIPBind GhcRn)
IPBind GhcRn
b)
rep_implicit_param_bind LIPBind GhcRn
_ = String -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> a
panic String
"rep_implicit_param_bind: Impossible Match"
                            -- due to #15884

rep_implicit_param_name :: HsIPName -> DsM (Core String)
rep_implicit_param_name :: HsIPName -> DsM (Core String)
rep_implicit_param_name (HsIPName CLabelString
name) = String -> DsM (Core String)
coreStringLit (CLabelString -> String
unpackFS CLabelString
name)

rep_val_binds :: HsValBinds GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
-- Assumes: all the binders of the binding are already in the meta-env
rep_val_binds :: HsValBinds GhcRn -> DsM [(SrcSpan, Core DecQ)]
rep_val_binds (XValBindsLR (NValBinds binds sigs))
 = do { [(SrcSpan, Core DecQ)]
core1 <- LHsBindsLR GhcRn GhcRn -> DsM [(SrcSpan, Core DecQ)]
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 DecQ)]
core2 <- [LSig GhcRn] -> DsM [(SrcSpan, Core DecQ)]
rep_sigs [LSig GhcRn]
sigs
      ; [(SrcSpan, Core DecQ)] -> DsM [(SrcSpan, Core DecQ)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SrcSpan, Core DecQ)]
core1 [(SrcSpan, Core DecQ)]
-> [(SrcSpan, Core DecQ)] -> [(SrcSpan, Core DecQ)]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, Core DecQ)]
core2) }
rep_val_binds (ValBinds XValBinds GhcRn GhcRn
_ LHsBindsLR GhcRn GhcRn
_ [LSig GhcRn]
_)
 = String -> DsM [(SrcSpan, Core DecQ)]
forall a. String -> a
panic String
"rep_val_binds: ValBinds"

rep_binds :: LHsBinds GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
rep_binds :: LHsBindsLR GhcRn GhcRn -> DsM [(SrcSpan, Core DecQ)]
rep_binds = (LHsBind GhcRn
 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ))
-> [LHsBind GhcRn] -> DsM [(SrcSpan, Core DecQ)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsBind GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_bind ([LHsBind GhcRn] -> DsM [(SrcSpan, Core DecQ)])
-> (LHsBindsLR GhcRn GhcRn -> [LHsBind GhcRn])
-> LHsBindsLR GhcRn GhcRn
-> DsM [(SrcSpan, Core DecQ)]
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 -> DsM (SrcSpan, Core TH.DecQ)
-- 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 -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (FunBind
                 { fun_id = fn,
                   fun_matches = MG { mg_alts
                           = (dL->L _ [dL->L _ (Match
                                       { m_pats = []
                                       , m_grhss = GRHSs _ guards
                                                     (dL->L _ wheres) }
                                      )]) } }))
 = do { ([GenSymBind]
ss,Core [DecQ]
wherecore) <- HsLocalBinds GhcRn -> DsM ([GenSymBind], Core [DecQ])
repBinds SrcSpanLess (LHsLocalBinds GhcRn)
HsLocalBinds GhcRn
wheres
        ; Core BodyQ
guardcore <- [GenSymBind] -> DsM (Core BodyQ) -> DsM (Core BodyQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss ([LGRHS GhcRn (LHsExpr GhcRn)] -> DsM (Core BodyQ)
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
guards)
        ; Core Name
fn'  <- Located Name -> DsM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
fn
        ; Core PatQ
p    <- Core Name -> DsM (Core PatQ)
repPvar Core Name
fn'
        ; Core DecQ
ans  <- Core PatQ -> Core BodyQ -> Core [DecQ] -> DsM (Core DecQ)
repVal Core PatQ
p Core BodyQ
guardcore Core [DecQ]
wherecore
        ; Core DecQ
ans' <- [GenSymBind] -> Core DecQ -> DsM (Core DecQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core DecQ
ans
        ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
ans') }

rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (FunBind { fun_id = fn
                             , fun_matches = MG { mg_alts = (dL->L _ ms) } }))
 =   do { [Core ClauseQ]
ms1 <- (LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core ClauseQ))
-> [LMatch GhcRn (LHsExpr GhcRn)]
-> IOEnv (Env DsGblEnv DsLclEnv) [Core ClauseQ]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core ClauseQ)
repClauseTup [LMatch GhcRn (LHsExpr GhcRn)]
SrcSpanLess (Located [LMatch GhcRn (LHsExpr GhcRn)])
ms
        ; Core Name
fn' <- Located Name -> DsM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
fn
        ; Core DecQ
ans <- Core Name -> Core [ClauseQ] -> DsM (Core DecQ)
repFun Core Name
fn' ([Core ClauseQ] -> Core [ClauseQ]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core ClauseQ]
ms1)
        ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
ans) }

rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (FunBind { fun_matches = XMatchGroup nec })) = NoExtCon -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. NoExtCon -> a
noExtCon XXMatchGroup GhcRn (LHsExpr GhcRn)
NoExtCon
nec

rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (PatBind { pat_lhs = pat
                             , pat_rhs = GRHSs _ guards (dL->L _ wheres) }))
 =   do { Core PatQ
patcore <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
pat
        ; ([GenSymBind]
ss,Core [DecQ]
wherecore) <- HsLocalBinds GhcRn -> DsM ([GenSymBind], Core [DecQ])
repBinds SrcSpanLess (LHsLocalBinds GhcRn)
HsLocalBinds GhcRn
wheres
        ; Core BodyQ
guardcore <- [GenSymBind] -> DsM (Core BodyQ) -> DsM (Core BodyQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss ([LGRHS GhcRn (LHsExpr GhcRn)] -> DsM (Core BodyQ)
repGuards [LGRHS GhcRn (LHsExpr GhcRn)]
guards)
        ; Core DecQ
ans  <- Core PatQ -> Core BodyQ -> Core [DecQ] -> DsM (Core DecQ)
repVal Core PatQ
patcore Core BodyQ
guardcore Core [DecQ]
wherecore
        ; Core DecQ
ans' <- [GenSymBind] -> Core DecQ -> DsM (Core DecQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core DecQ
ans
        ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
ans') }
rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (PatBind _ _ (XGRHSs nec) _)) = NoExtCon -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. NoExtCon -> a
noExtCon XXGRHSs GhcRn (LHsExpr GhcRn)
NoExtCon
nec

rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (VarBind { var_id = v, var_rhs = e}))
 =   do { Core Name
v' <- Name -> DsM (Core Name)
lookupBinder Name
IdP GhcRn
v
        ; Core ExpQ
e2 <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e
        ; Core BodyQ
x <- Core ExpQ -> DsM (Core BodyQ)
repNormal Core ExpQ
e2
        ; Core PatQ
patcore <- Core Name -> DsM (Core PatQ)
repPvar Core Name
v'
        ; Core [DecQ]
empty_decls <- Name -> [Core DecQ] -> DsM (Core [DecQ])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
decQTyConName []
        ; Core DecQ
ans <- Core PatQ -> Core BodyQ -> Core [DecQ] -> DsM (Core DecQ)
repVal Core PatQ
patcore Core BodyQ
x Core [DecQ]
empty_decls
        ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
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 DecQ
ans) }

rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (AbsBinds {}))  = String -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> a
panic String
"rep_bind: AbsBinds"
rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (PatSynBind _ (PSB { psb_id   = syn
                                       , psb_args = args
                                       , psb_def  = pat
                                       , psb_dir  = dir })))
  = do { Core Name
syn'      <- Located Name -> DsM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
syn
       ; Core PatSynDirQ
dir'      <- HsPatSynDir GhcRn -> DsM (Core PatSynDirQ)
repPatSynDir HsPatSynDir GhcRn
dir
       ; [GenSymBind]
ss        <- HsPatSynDetails (Located Name) -> DsM [GenSymBind]
mkGenArgSyms HsPatSynDetails (Located Name)
HsPatSynDetails (Located (IdP GhcRn))
args
       ; Core DecQ
patSynD'  <- [GenSymBind] -> DsM (Core DecQ) -> DsM (Core DecQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss (
         do { Core PatSynArgsQ
args'  <- HsPatSynDetails (Located Name) -> DsM (Core PatSynArgsQ)
repPatSynArgs HsPatSynDetails (Located Name)
HsPatSynDetails (Located (IdP GhcRn))
args
            ; Core PatQ
pat'   <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
pat
            ; Core Name
-> Core PatSynArgsQ
-> Core PatSynDirQ
-> Core PatQ
-> DsM (Core DecQ)
repPatSynD Core Name
syn' Core PatSynArgsQ
args' Core PatSynDirQ
dir' Core PatQ
pat' })
       ; Core DecQ
patSynD'' <- HsPatSynDetails (Located Name)
-> [GenSymBind] -> Core DecQ -> DsM (Core DecQ)
wrapGenArgSyms HsPatSynDetails (Located Name)
HsPatSynDetails (Located (IdP GhcRn))
args [GenSymBind]
ss Core DecQ
patSynD'
       ; (SrcSpan, Core DecQ)
-> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
loc, Core DecQ
patSynD'') }
  where
    mkGenArgSyms :: HsPatSynDetails (Located Name) -> DsM [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) -> DsM [GenSymBind]
mkGenArgSyms (PrefixCon [Located Name]
args)     = [Name] -> DsM [GenSymBind]
mkGenSyms ((Located Name -> Name) -> [Located Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located Name]
args)
    mkGenArgSyms (InfixCon Located Name
arg1 Located Name
arg2) = [Name] -> DsM [GenSymBind]
mkGenSyms [Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
arg1, Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
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 a. HasSrcSpan a => a -> SrcSpanLess a
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 a. HasSrcSpan a => a -> SrcSpanLess a
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] -> DsM [GenSymBind]
mkGenSyms [Name]
sels
           ; [GenSymBind] -> DsM [GenSymBind]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenSymBind] -> DsM [GenSymBind])
-> [GenSymBind] -> DsM [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 TH.DecQ -> DsM (Core TH.DecQ)
    wrapGenArgSyms :: HsPatSynDetails (Located Name)
-> [GenSymBind] -> Core DecQ -> DsM (Core DecQ)
wrapGenArgSyms (RecCon [RecordPatSynField (Located Name)]
_) [GenSymBind]
_  Core DecQ
dec = Core DecQ -> DsM (Core DecQ)
forall (m :: * -> *) a. Monad m => a -> m a
return Core DecQ
dec
    wrapGenArgSyms HsPatSynDetails (Located Name)
_          [GenSymBind]
ss Core DecQ
dec = [GenSymBind] -> Core DecQ -> DsM (Core DecQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core DecQ
dec

rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (PatSynBind _ (XPatSynBind nec)))
  = NoExtCon -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. NoExtCon -> a
noExtCon XXPatSynBind GhcRn GhcRn
NoExtCon
nec
rep_bind (LHsBind GhcRn -> Located (SrcSpanLess (LHsBind GhcRn))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (XHsBindsLR nec)) = NoExtCon -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. NoExtCon -> a
noExtCon XXHsBindsLR GhcRn GhcRn
NoExtCon
nec
rep_bind LHsBind GhcRn
_                          = String -> IOEnv (Env DsGblEnv DsLclEnv) (SrcSpan, Core DecQ)
forall a. String -> a
panic String
"rep_bind: Impossible match!"
                                      -- due to #15884

repPatSynD :: Core TH.Name
           -> Core TH.PatSynArgsQ
           -> Core TH.PatSynDirQ
           -> Core TH.PatQ
           -> DsM (Core TH.DecQ)
repPatSynD :: Core Name
-> Core PatSynArgsQ
-> Core PatSynDirQ
-> Core PatQ
-> DsM (Core DecQ)
repPatSynD (MkC CoreExpr
syn) (MkC CoreExpr
args) (MkC CoreExpr
dir) (MkC CoreExpr
pat)
  = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
patSynDName [CoreExpr
syn, CoreExpr
args, CoreExpr
dir, CoreExpr
pat]

repPatSynArgs :: HsPatSynDetails (Located Name) -> DsM (Core TH.PatSynArgsQ)
repPatSynArgs :: HsPatSynDetails (Located Name) -> DsM (Core PatSynArgsQ)
repPatSynArgs (PrefixCon [Located Name]
args)
  = do { Core [Name]
args' <- Name
-> (Located Name -> DsM (Core Name))
-> [Located Name]
-> DsM (Core [Name])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
nameTyConName Located Name -> DsM (Core Name)
lookupLOcc [Located Name]
args
       ; Core [Name] -> DsM (Core PatSynArgsQ)
repPrefixPatSynArgs Core [Name]
args' }
repPatSynArgs (InfixCon Located Name
arg1 Located Name
arg2)
  = do { Core Name
arg1' <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
arg1
       ; Core Name
arg2' <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
arg2
       ; Core Name -> Core Name -> DsM (Core PatSynArgsQ)
repInfixPatSynArgs Core Name
arg1' Core Name
arg2' }
repPatSynArgs (RecCon [RecordPatSynField (Located Name)]
fields)
  = do { Core [Name]
sels' <- Name
-> (Located Name -> DsM (Core Name))
-> [Located Name]
-> DsM (Core [Name])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
nameTyConName Located Name -> DsM (Core Name)
lookupLOcc [Located Name]
sels
       ; Core [Name] -> DsM (Core PatSynArgsQ)
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] -> DsM (Core TH.PatSynArgsQ)
repPrefixPatSynArgs :: Core [Name] -> DsM (Core PatSynArgsQ)
repPrefixPatSynArgs (MkC CoreExpr
nms) = Name -> [CoreExpr] -> DsM (Core PatSynArgsQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
prefixPatSynName [CoreExpr
nms]

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

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

repPatSynDir :: HsPatSynDir GhcRn -> DsM (Core TH.PatSynDirQ)
repPatSynDir :: HsPatSynDir GhcRn -> DsM (Core PatSynDirQ)
repPatSynDir HsPatSynDir GhcRn
Unidirectional        = Name -> [CoreExpr] -> DsM (Core PatSynDirQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
unidirPatSynName []
repPatSynDir HsPatSynDir GhcRn
ImplicitBidirectional = Name -> [CoreExpr] -> DsM (Core PatSynDirQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
implBidirPatSynName []
repPatSynDir (ExplicitBidirectional (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = (Located [LMatch GhcRn (LHsExpr GhcRn)]
-> Located (SrcSpanLess (Located [LMatch GhcRn (LHsExpr GhcRn)]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located [LMatch GhcRn (LHsExpr GhcRn)])
clauses) }))
  = do { [Core ClauseQ]
clauses' <- (LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core ClauseQ))
-> [LMatch GhcRn (LHsExpr GhcRn)]
-> IOEnv (Env DsGblEnv DsLclEnv) [Core ClauseQ]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core ClauseQ)
repClauseTup [LMatch GhcRn (LHsExpr GhcRn)]
SrcSpanLess (Located [LMatch GhcRn (LHsExpr GhcRn)])
clauses
       ; Core [ClauseQ] -> DsM (Core PatSynDirQ)
repExplBidirPatSynDir ([Core ClauseQ] -> Core [ClauseQ]
forall a. [Core a] -> Core [a]
nonEmptyCoreList [Core ClauseQ]
clauses') }
repPatSynDir (ExplicitBidirectional (XMatchGroup XXMatchGroup GhcRn (LHsExpr GhcRn)
nec)) = NoExtCon -> DsM (Core PatSynDirQ)
forall a. NoExtCon -> a
noExtCon XXMatchGroup GhcRn (LHsExpr GhcRn)
NoExtCon
nec

repExplBidirPatSynDir :: Core [TH.ClauseQ] -> DsM (Core TH.PatSynDirQ)
repExplBidirPatSynDir :: Core [ClauseQ] -> DsM (Core PatSynDirQ)
repExplBidirPatSynDir (MkC CoreExpr
cls) = Name -> [CoreExpr] -> DsM (Core PatSynDirQ)
forall a. Name -> [CoreExpr] -> DsM (Core 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) -> DsM (Core TH.ExpQ)
repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core ExpQ)
repLambda (LMatch GhcRn (LHsExpr GhcRn)
-> Located (SrcSpanLess (LMatch GhcRn (LHsExpr GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (Match { m_pats = ps
                          , m_grhss = GRHSs _ [dL->L _ (GRHS _ [] e)]
                                              (dL->L _ (EmptyLocalBinds _)) } ))
 = do { let bndrs :: [IdP GhcRn]
bndrs = [LPat GhcRn] -> [IdP GhcRn]
forall (p :: Pass). [LPat (GhcPass p)] -> [IdP (GhcPass p)]
collectPatsBinders [LPat GhcRn]
ps ;
      ; [GenSymBind]
ss  <- [Name] -> DsM [GenSymBind]
mkGenSyms [Name]
[IdP GhcRn]
bndrs
      ; Core ExpQ
lam <- [GenSymBind] -> DsM (Core ExpQ) -> DsM (Core ExpQ)
forall a. [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
ss (
                do { Core [PatQ]
xs <- [LPat GhcRn] -> DsM (Core [PatQ])
repLPs [LPat GhcRn]
ps; Core ExpQ
body <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e; Core [PatQ] -> Core ExpQ -> DsM (Core ExpQ)
repLam Core [PatQ]
xs Core ExpQ
body })
      ; [GenSymBind] -> Core ExpQ -> DsM (Core ExpQ)
forall a. [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
ss Core ExpQ
lam }

repLambda (LMatch GhcRn (LHsExpr GhcRn)
-> Located (SrcSpanLess (LMatch GhcRn (LHsExpr GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LMatch GhcRn (LHsExpr GhcRn))
m) = String -> SDoc -> DsM (Core ExpQ)
forall a. String -> SDoc -> DsM a
notHandled String
"Guarded lambdas" (Match GhcRn (LHsExpr GhcRn) -> SDoc
forall (idR :: Pass) body.
(OutputableBndrId idR, Outputable body) =>
Match (GhcPass idR) body -> SDoc
pprMatch SrcSpanLess (LMatch GhcRn (LHsExpr GhcRn))
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] -> DsM (Core [TH.PatQ])
repLPs :: [LPat GhcRn] -> DsM (Core [PatQ])
repLPs [LPat GhcRn]
ps = Name
-> (Located (Pat GhcRn) -> DsM (Core PatQ))
-> [Located (Pat GhcRn)]
-> DsM (Core [PatQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
patQTyConName Located (Pat GhcRn) -> DsM (Core PatQ)
LPat GhcRn -> DsM (Core PatQ)
repLP [Located (Pat GhcRn)]
[LPat GhcRn]
ps

repLP :: LPat GhcRn -> DsM (Core TH.PatQ)
repLP :: LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p = Pat GhcRn -> DsM (Core PatQ)
repP (Located (Pat GhcRn) -> SrcSpanLess (Located (Pat GhcRn))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (Pat GhcRn)
LPat GhcRn
p)

repP :: Pat GhcRn -> DsM (Core TH.PatQ)
repP :: Pat GhcRn -> DsM (Core PatQ)
repP (WildPat XWildPat GhcRn
_)        = DsM (Core PatQ)
repPwild
repP (LitPat XLitPat GhcRn
_ HsLit GhcRn
l)       = do { Core Lit
l2 <- HsLit GhcRn -> DsM (Core Lit)
repLiteral HsLit GhcRn
l; Core Lit -> DsM (Core PatQ)
repPlit Core Lit
l2 }
repP (VarPat XVarPat GhcRn
_ Located (IdP GhcRn)
x)       = do { Core Name
x' <- Name -> DsM (Core Name)
lookupBinder (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
Located (IdP GhcRn)
x); Core Name -> DsM (Core PatQ)
repPvar Core Name
x' }
repP (LazyPat XLazyPat GhcRn
_ LPat GhcRn
p)      = do { Core PatQ
p1 <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p; Core PatQ -> DsM (Core PatQ)
repPtilde Core PatQ
p1 }
repP (BangPat XBangPat GhcRn
_ LPat GhcRn
p)      = do { Core PatQ
p1 <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p; Core PatQ -> DsM (Core PatQ)
repPbang Core PatQ
p1 }
repP (AsPat XAsPat GhcRn
_ Located (IdP GhcRn)
x LPat GhcRn
p)      = do { Core Name
x' <- Located Name -> DsM (Core Name)
lookupLBinder Located Name
Located (IdP GhcRn)
x; Core PatQ
p1 <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p
                             ; Core Name -> Core PatQ -> DsM (Core PatQ)
repPaspat Core Name
x' Core PatQ
p1 }
repP (ParPat XParPat GhcRn
_ LPat GhcRn
p)       = LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p
repP (ListPat XListPat GhcRn
Nothing [LPat GhcRn]
ps)  = do { Core [PatQ]
qs <- [LPat GhcRn] -> DsM (Core [PatQ])
repLPs [LPat GhcRn]
ps; Core [PatQ] -> DsM (Core PatQ)
repPlist Core [PatQ]
qs }
repP (ListPat (Just e) [LPat GhcRn]
ps) = do { Core PatQ
p <- Pat GhcRn -> DsM (Core PatQ)
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 ExpQ
e' <- HsExpr GhcRn -> DsM (Core ExpQ)
repE (SyntaxExpr GhcRn -> HsExpr GhcRn
forall p. SyntaxExpr p -> HsExpr p
syn_expr SyntaxExpr GhcRn
e)
                                ; Core ExpQ -> Core PatQ -> DsM (Core PatQ)
repPview Core ExpQ
e' Core PatQ
p}
repP (TuplePat XTuplePat GhcRn
_ [LPat GhcRn]
ps Boxity
boxed)
  | Boxity -> Bool
isBoxed Boxity
boxed       = do { Core [PatQ]
qs <- [LPat GhcRn] -> DsM (Core [PatQ])
repLPs [LPat GhcRn]
ps; Core [PatQ] -> DsM (Core PatQ)
repPtup Core [PatQ]
qs }
  | Bool
otherwise           = do { Core [PatQ]
qs <- [LPat GhcRn] -> DsM (Core [PatQ])
repLPs [LPat GhcRn]
ps; Core [PatQ] -> DsM (Core PatQ)
repPunboxedTup Core [PatQ]
qs }
repP (SumPat XSumPat GhcRn
_ LPat GhcRn
p Int
alt Int
arity) = do { Core PatQ
p1 <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p
                                 ; Core PatQ -> Int -> Int -> DsM (Core PatQ)
repPunboxedSum Core PatQ
p1 Int
alt Int
arity }
repP (ConPatIn Located (IdP GhcRn)
dc HsConPatDetails GhcRn
details)
 = do { Core Name
con_str <- Located Name -> DsM (Core Name)
lookupLOcc Located Name
Located (IdP GhcRn)
dc
      ; case HsConPatDetails GhcRn
details of
         PrefixCon [LPat GhcRn]
ps -> do { Core [PatQ]
qs <- [LPat GhcRn] -> DsM (Core [PatQ])
repLPs [LPat GhcRn]
ps; Core Name -> Core [PatQ] -> DsM (Core PatQ)
repPcon Core Name
con_str Core [PatQ]
qs }
         RecCon HsRecFields GhcRn (LPat GhcRn)
rec   -> do { Core [(Name, PatQ)]
fps <- Name
-> (LHsRecField GhcRn (Located (Pat GhcRn))
    -> DsM (Core (Name, PatQ)))
-> [LHsRecField GhcRn (Located (Pat GhcRn))]
-> DsM (Core [(Name, PatQ)])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
fieldPatQTyConName LHsRecField GhcRn (Located (Pat GhcRn)) -> DsM (Core (Name, PatQ))
LHsRecField GhcRn (LPat GhcRn) -> DsM (Core (Name, PatQ))
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 [(Name, PatQ)] -> DsM (Core PatQ)
repPrec Core Name
con_str Core [(Name, PatQ)]
fps }
         InfixCon LPat GhcRn
p1 LPat GhcRn
p2 -> do { Core PatQ
p1' <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p1;
                                Core PatQ
p2' <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p2;
                                Core PatQ -> Core Name -> Core PatQ -> DsM (Core PatQ)
repPinfix Core PatQ
p1' Core Name
con_str Core PatQ
p2' }
   }
 where
   rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> DsM (Core (TH.Name,TH.PatQ))
   rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> DsM (Core (Name, PatQ))
rep_fld (LHsRecField GhcRn (LPat GhcRn)
-> Located (SrcSpanLess (LHsRecField GhcRn (Located (Pat GhcRn))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (LHsRecField GhcRn (Located (Pat GhcRn)))
fld) = do { MkC CoreExpr
v <- Located Name -> DsM (Core Name)
lookupLOcc (HsRecField GhcRn (Located (Pat GhcRn))
-> Located (XCFieldOcc GhcRn)
forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel SrcSpanLess (LHsRecField GhcRn (Located (Pat GhcRn)))
HsRecField GhcRn (Located (Pat GhcRn))
fld)
                              ; MkC CoreExpr
p <- LPat GhcRn -> DsM (Core PatQ)
repLP (HsRecField GhcRn (Located (Pat GhcRn)) -> Located (Pat GhcRn)
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg SrcSpanLess (LHsRecField GhcRn (Located (Pat GhcRn)))
HsRecField GhcRn (Located (Pat GhcRn))
fld)
                              ; Name -> [CoreExpr] -> DsM (Core (Name, PatQ))
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
fieldPatName [CoreExpr
v,CoreExpr
p] }

repP (NPat XNPat GhcRn
_ (Located (HsOverLit GhcRn)
-> Located (SrcSpanLess (Located (HsOverLit GhcRn)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located (HsOverLit GhcRn))
l) Maybe (SyntaxExpr GhcRn)
Nothing SyntaxExpr GhcRn
_) = do { Core Lit
a <- HsOverLit GhcRn -> DsM (Core Lit)
repOverloadedLiteral SrcSpanLess (Located (HsOverLit GhcRn))
HsOverLit GhcRn
l
                                         ; Core Lit -> DsM (Core PatQ)
repPlit Core Lit
a }
repP (ViewPat XViewPat GhcRn
_ LHsExpr GhcRn
e LPat GhcRn
p) = do { Core ExpQ
e' <- LHsExpr GhcRn -> DsM (Core ExpQ)
repLE LHsExpr GhcRn
e; Core PatQ
p' <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p; Core ExpQ -> Core PatQ -> DsM (Core PatQ)
repPview Core ExpQ
e' Core PatQ
p' }
repP p :: Pat GhcRn
p@(NPat XNPat GhcRn
_ Located (HsOverLit GhcRn)
_ (Just SyntaxExpr GhcRn
_) SyntaxExpr GhcRn
_) = String -> SDoc -> DsM (Core PatQ)
forall a. String -> SDoc -> DsM 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 LHsSigWcType (NoGhcTc GhcRn)
t) = do { Core PatQ
p' <- LPat GhcRn -> DsM (Core PatQ)
repLP LPat GhcRn
p
                         ; Core TypeQ
t' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy (HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
-> LHsType GhcRn
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType (NoGhcTc GhcRn)
HsWildCardBndrs GhcRn (HsImplicitBndrs GhcRn (LHsType GhcRn))
t)
                         ; Core PatQ -> Core TypeQ -> DsM (Core PatQ)
repPsig Core PatQ
p' Core TypeQ
t' }
repP (SplicePat XSplicePat GhcRn
_ HsSplice GhcRn
splice) = HsSplice GhcRn -> DsM (Core PatQ)
forall a. HsSplice GhcRn -> DsM (Core a)
repSplice HsSplice GhcRn
splice

repP Pat GhcRn
other = String -> SDoc -> DsM (Core PatQ)
forall a. String -> SDoc -> DsM 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 :: [(SrcSpan, a)] -> [(SrcSpan, a)]
sort_by_loc [(SrcSpan, a)]
xs = ((SrcSpan, a) -> (SrcSpan, a) -> Ordering)
-> [(SrcSpan, a)] -> [(SrcSpan, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan, a) -> (SrcSpan, a) -> Ordering
forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
comp [(SrcSpan, a)]
xs
    where comp :: (a, b) -> (a, b) -> Ordering
comp (a, b)
x (a, b)
y = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
y)

de_loc :: [(a, b)] -> [b]
de_loc :: [(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] -> DsM [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] -> DsM [GenSymBind]
mkGenSyms [Name]
ns = do { Type
var_ty <- Name -> DsM Type
lookupType Name
nameTyConName
                  ; [GenSymBind] -> DsM [GenSymBind]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name
nm, Name -> Type -> Id
mkLocalId (Name -> Name
localiseName Name
nm) Type
var_ty) | Name
nm <- [Name]
ns] }


addBinds :: [GenSymBind] -> DsM a -> DsM 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 :: [GenSymBind] -> DsM a -> DsM a
addBinds [GenSymBind]
bs DsM a
m = DsMetaEnv -> DsM a -> DsM 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]) DsM a
m

-- Look up a locally bound name
--
lookupLBinder :: Located Name -> DsM (Core TH.Name)
lookupLBinder :: Located Name -> DsM (Core Name)
lookupLBinder Located Name
n = Name -> DsM (Core Name)
lookupBinder (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
n)

lookupBinder :: Name -> DsM (Core TH.Name)
lookupBinder :: Name -> DsM (Core Name)
lookupBinder = Name -> DsM (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 -> DsM (Core TH.Name)
-- Lookup an occurrence; it can't be a splice.
-- Use the in-scope bindings if they exist
lookupLOcc :: Located Name -> DsM (Core Name)
lookupLOcc Located Name
n = Name -> DsM (Core Name)
lookupOcc (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
n)

lookupOcc :: Name -> DsM (Core TH.Name)
lookupOcc :: Name -> DsM (Core Name)
lookupOcc Name
n
  = do {  Maybe DsMetaVal
mb_val <- Name -> DsM (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 -> DsM (Core String)
coreStringLit String
name_mod
        ; MkC CoreExpr
pkg <- String -> DsM (Core String)
coreStringLit String
name_pkg
        ; MkC CoreExpr
occ <- Name -> DsM (Core String)
nameLit Name
name
        ; Name -> [CoreExpr] -> DsM (Core Name)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
mk_varg [CoreExpr
pkg,CoreExpr
mod,CoreExpr
occ] }
  | Bool
otherwise
  = do  { MkC CoreExpr
occ <- Name -> DsM (Core String)
nameLit Name
name
        ; MkC CoreExpr
uni <- Integer -> DsM (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. Name -> [CoreExpr] -> DsM (Core a)
rep2 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
moduleName Module
mod)
      name_pkg :: String
name_pkg = UnitId -> String
unitIdString (Module -> UnitId
moduleUnitId Module
mod)
      name_occ :: OccName
name_occ = Name -> OccName
nameOccName Name
name
      mk_varg :: Name
mk_varg | OccName -> Bool
OccName.isDataOcc OccName
name_occ = Name
mkNameG_dName
              | OccName -> Bool
OccName.isVarOcc  OccName
name_occ = Name
mkNameG_vName
              | OccName -> Bool
OccName.isTcOcc   OccName
name_occ = Name
mkNameG_tcName
              | Bool
otherwise                  = String -> SDoc -> Name
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"DsMeta.globalVar" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)

lookupType :: Name      -- Name of type constructor (e.g. TH.ExpQ)
           -> DsM Type  -- The type
lookupType :: Name -> DsM Type
lookupType Name
tc_name = do { TyCon
tc <- Name -> DsM TyCon
dsLookupTyCon Name
tc_name ;
                          Type -> DsM Type
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> [Type] -> Type
mkTyConApp TyCon
tc []) }

wrapGenSyms :: [GenSymBind]
            -> Core (TH.Q a) -> DsM (Core (TH.Q a))
-- wrapGenSyms [(nm1,id1), (nm2,id2)] y
--      --> bindQ (gensym nm1) (\ id1 ->
--          bindQ (gensym nm2 (\ id2 ->
--          y))

wrapGenSyms :: [GenSymBind] -> Core (Q a) -> DsM (Core (Q a))
wrapGenSyms [GenSymBind]
binds body :: Core (Q a)
body@(MkC CoreExpr
b)
  = do  { Type
var_ty <- Name -> DsM Type
lookupType Name
nameTyConName
        ; Type -> [GenSymBind] -> DsM (Core (Q a))
go Type
var_ty [GenSymBind]
binds }
  where
    [Type
elt_ty] = Type -> [Type]
tcTyConAppArgs (CoreExpr -> Type
exprType CoreExpr
b)
        -- b :: Q a, so we can get the type 'a' by looking at the
        -- argument type. NB: this relies on Q being a data/newtype,
        -- not a type synonym

    go :: Type -> [GenSymBind] -> DsM (Core (Q a))
go Type
_ [] = Core (Q a) -> DsM (Core (Q a))
forall (m :: * -> *) a. Monad m => a -> m a
return Core (Q a)
body
    go Type
var_ty ((Name
name,Id
id) : [GenSymBind]
binds)
      = do { MkC CoreExpr
body'  <- Type -> [GenSymBind] -> DsM (Core (Q a))
go Type
var_ty [GenSymBind]
binds
           ; Core String
lit_str    <- Name -> DsM (Core String)
nameLit Name
name
           ; Core (Q Name)
gensym_app <- Core String -> DsM (Core (Q Name))
repGensym Core String
lit_str
           ; Type
-> Type -> Core (Q Name) -> Core (Name -> Q a) -> DsM (Core (Q a))
forall a b.
Type -> Type -> Core (Q a) -> Core (a -> Q b) -> DsM (Core (Q b))
repBindQ Type
var_ty Type
elt_ty
                      Core (Q Name)
gensym_app (CoreExpr -> Core (Name -> Q 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 -> DsM (Core String)
nameLit Name
n = String -> DsM (Core String)
coreStringLit (OccName -> String
occNameString (Name -> OccName
nameOccName Name
n))

occNameLit :: OccName -> DsM (Core String)
occNameLit :: OccName -> DsM (Core String)
occNameLit OccName
name = String -> DsM (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 :: Core a -> CoreExpr
unC (MkC CoreExpr
x) = CoreExpr
x

rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
rep2 :: Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
n [CoreExpr]
xs = do { Id
id <- Name -> DsM Id
dsLookupGlobalId Name
n
               ; Core a -> DsM (Core a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core a
forall a. CoreExpr -> Core a
MkC ((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 (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
id) [CoreExpr]
xs)) }

dataCon' :: Name -> [CoreExpr] -> DsM (Core a)
dataCon' :: Name -> [CoreExpr] -> DsM (Core a)
dataCon' Name
n [CoreExpr]
args = do { DataCon
id <- Name -> DsM DataCon
dsLookupDataCon Name
n
                     ; Core a -> DsM (Core a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Core a -> DsM (Core a)) -> Core a -> DsM (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 -> DsM (Core a)
dataCon :: Name -> DsM (Core a)
dataCon Name
n = Name -> [CoreExpr] -> DsM (Core a)
forall a. Name -> [CoreExpr] -> DsM (Core a)
dataCon' Name
n []


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

--------------- Patterns -----------------
repPlit   :: Core TH.Lit -> DsM (Core TH.PatQ)
repPlit :: Core Lit -> DsM (Core PatQ)
repPlit (MkC CoreExpr
l) = Name -> [CoreExpr] -> DsM (Core PatQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
litPName [CoreExpr
l]

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

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

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

repPunboxedSum :: Core TH.PatQ -> TH.SumAlt -> TH.SumArity -> DsM (Core TH.PatQ)
-- Note: not Core TH.SumAlt or Core TH.SumArity; it's easier to be direct here
repPunboxedSum :: Core PatQ -> Int -> Int -> DsM (Core PatQ)
repPunboxedSum (MkC CoreExpr
p) Int
alt Int
arity
 = do { DynFlags
dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      ; Name -> [CoreExpr] -> DsM (Core PatQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
unboxedSumPName [ CoreExpr
p
                             , DynFlags -> Int -> CoreExpr
mkIntExprInt DynFlags
dflags Int
alt
                             , DynFlags -> Int -> CoreExpr
mkIntExprInt DynFlags
dflags Int
arity ] }

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

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

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

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

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

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

repPwild  :: DsM (Core TH.PatQ)
repPwild :: DsM (Core PatQ)
repPwild = Name -> [CoreExpr] -> DsM (Core PatQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
wildPName []

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

repPview :: Core TH.ExpQ -> Core TH.PatQ -> DsM (Core TH.PatQ)
repPview :: Core ExpQ -> Core PatQ -> DsM (Core PatQ)
repPview (MkC CoreExpr
e) (MkC CoreExpr
p) = Name -> [CoreExpr] -> DsM (Core PatQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
viewPName [CoreExpr
e,CoreExpr
p]

repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
repPsig :: Core PatQ -> Core TypeQ -> DsM (Core PatQ)
repPsig (MkC CoreExpr
p) (MkC CoreExpr
t) = Name -> [CoreExpr] -> DsM (Core PatQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
sigPName [CoreExpr
p, CoreExpr
t]

--------------- Expressions -----------------
repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
repVarOrCon :: Name -> Core Name -> DsM (Core ExpQ)
repVarOrCon Name
vc Core Name
str | OccName -> Bool
isDataOcc (Name -> OccName
nameOccName Name
vc) = Core Name -> DsM (Core ExpQ)
repCon Core Name
str
                   | Bool
otherwise                  = Core Name -> DsM (Core ExpQ)
repVar Core Name
str

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

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

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

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

repAppType :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
repAppType :: Core ExpQ -> Core TypeQ -> DsM (Core ExpQ)
repAppType (MkC CoreExpr
x) (MkC CoreExpr
y) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
appTypeEName [CoreExpr
x,CoreExpr
y]

repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
repLam :: Core [PatQ] -> Core ExpQ -> DsM (Core ExpQ)
repLam (MkC CoreExpr
ps) (MkC CoreExpr
e) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
lamEName [CoreExpr
ps, CoreExpr
e]

repLamCase :: Core [TH.MatchQ] -> DsM (Core TH.ExpQ)
repLamCase :: Core [MatchQ] -> DsM (Core ExpQ)
repLamCase (MkC CoreExpr
ms) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
lamCaseEName [CoreExpr
ms]

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

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

repUnboxedSum :: Core TH.ExpQ -> TH.SumAlt -> TH.SumArity -> DsM (Core TH.ExpQ)
-- Note: not Core TH.SumAlt or Core TH.SumArity; it's easier to be direct here
repUnboxedSum :: Core ExpQ -> Int -> Int -> DsM (Core ExpQ)
repUnboxedSum (MkC CoreExpr
e) Int
alt Int
arity
 = do { DynFlags
dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      ; Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
unboxedSumEName [ CoreExpr
e
                             , DynFlags -> Int -> CoreExpr
mkIntExprInt DynFlags
dflags Int
alt
                             , DynFlags -> Int -> CoreExpr
mkIntExprInt DynFlags
dflags Int
arity ] }

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

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

repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
repLetE :: Core [DecQ] -> Core ExpQ -> DsM (Core ExpQ)
repLetE (MkC CoreExpr
ds) (MkC CoreExpr
e) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
letEName [CoreExpr
ds, CoreExpr
e]

repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM (Core TH.ExpQ)
repCaseE :: Core ExpQ -> Core [MatchQ] -> DsM (Core ExpQ)
repCaseE (MkC CoreExpr
e) (MkC CoreExpr
ms) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
caseEName [CoreExpr
e, CoreExpr
ms]

repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
repDoE :: Core [StmtQ] -> DsM (Core ExpQ)
repDoE (MkC CoreExpr
ss) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
doEName [CoreExpr
ss]

repMDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
repMDoE :: Core [StmtQ] -> DsM (Core ExpQ)
repMDoE (MkC CoreExpr
ss) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
mdoEName [CoreExpr
ss]

repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
repComp :: Core [StmtQ] -> DsM (Core ExpQ)
repComp (MkC CoreExpr
ss) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
compEName [CoreExpr
ss]

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

repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
repSigExp :: Core ExpQ -> Core TypeQ -> DsM (Core ExpQ)
repSigExp (MkC CoreExpr
e) (MkC CoreExpr
t) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
sigEName [CoreExpr
e,CoreExpr
t]

repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
repRecCon :: Core Name -> Core [Q FieldExp] -> DsM (Core ExpQ)
repRecCon (MkC CoreExpr
c) (MkC CoreExpr
fs) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
recConEName [CoreExpr
c,CoreExpr
fs]

repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
repRecUpd :: Core ExpQ -> Core [Q FieldExp] -> DsM (Core ExpQ)
repRecUpd (MkC CoreExpr
e) (MkC CoreExpr
fs) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
recUpdEName [CoreExpr
e,CoreExpr
fs]

repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
repFieldExp :: Core Name -> Core ExpQ -> DsM (Core (Q FieldExp))
repFieldExp (MkC CoreExpr
n) (MkC CoreExpr
x) = Name -> [CoreExpr] -> DsM (Core (Q FieldExp))
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
fieldExpName [CoreExpr
n,CoreExpr
x]

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

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

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

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

------------ Right hand sides (guarded expressions) ----
repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
repGuarded :: Core [Q (Guard, Exp)] -> DsM (Core BodyQ)
repGuarded (MkC CoreExpr
pairs) = Name -> [CoreExpr] -> DsM (Core BodyQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
guardedBName [CoreExpr
pairs]

repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
repNormal :: Core ExpQ -> DsM (Core BodyQ)
repNormal (MkC CoreExpr
e) = Name -> [CoreExpr] -> DsM (Core BodyQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
normalBName [CoreExpr
e]

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

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

repPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
repPatGE :: Core [StmtQ] -> Core ExpQ -> DsM (Core (Q (Guard, Exp)))
repPatGE (MkC CoreExpr
ss) (MkC CoreExpr
e) = Name -> [CoreExpr] -> DsM (Core (Q (Guard, Exp)))
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
patGEName [CoreExpr
ss, CoreExpr
e]

------------- Stmts -------------------
repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
repBindSt :: Core PatQ -> Core ExpQ -> DsM (Core StmtQ)
repBindSt (MkC CoreExpr
p) (MkC CoreExpr
e) = Name -> [CoreExpr] -> DsM (Core StmtQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
bindSName [CoreExpr
p,CoreExpr
e]

repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
repLetSt :: Core [DecQ] -> DsM (Core StmtQ)
repLetSt (MkC CoreExpr
ds) = Name -> [CoreExpr] -> DsM (Core StmtQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
letSName [CoreExpr
ds]

repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
repNoBindSt :: Core ExpQ -> DsM (Core StmtQ)
repNoBindSt (MkC CoreExpr
e) = Name -> [CoreExpr] -> DsM (Core StmtQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
noBindSName [CoreExpr
e]

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

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

-------------- Range (Arithmetic sequences) -----------
repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
repFrom :: Core ExpQ -> DsM (Core ExpQ)
repFrom (MkC CoreExpr
x) = Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
fromEName [CoreExpr
x]

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

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

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

------------ Match and Clause Tuples -----------
repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
repMatch :: Core PatQ
-> Core BodyQ
-> Core [DecQ]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
repMatch (MkC CoreExpr
p) (MkC CoreExpr
bod) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) (Core MatchQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
matchName [CoreExpr
p, CoreExpr
bod, CoreExpr
ds]

repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
repClause :: Core [PatQ] -> Core BodyQ -> Core [DecQ] -> DsM (Core ClauseQ)
repClause (MkC CoreExpr
ps) (MkC CoreExpr
bod) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> DsM (Core ClauseQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
clauseName [CoreExpr
ps, CoreExpr
bod, CoreExpr
ds]

-------------- Dec -----------------------------
repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
repVal :: Core PatQ -> Core BodyQ -> Core [DecQ] -> DsM (Core DecQ)
repVal (MkC CoreExpr
p) (MkC CoreExpr
b) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
valDName [CoreExpr
p, CoreExpr
b, CoreExpr
ds]

repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
repFun :: Core Name -> Core [ClauseQ] -> DsM (Core DecQ)
repFun (MkC CoreExpr
nm) (MkC CoreExpr
b) = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
funDName [CoreExpr
nm, CoreExpr
b]

repData :: Core TH.CxtQ -> Core TH.Name
        -> Either (Core [TH.TyVarBndrQ])
                  (Core (Maybe [TH.TyVarBndrQ]), Core TH.TypeQ)
        -> Core (Maybe TH.KindQ) -> Core [TH.ConQ] -> Core [TH.DerivClauseQ]
        -> DsM (Core TH.DecQ)
repData :: Core CxtQ
-> Core Name
-> Either
     (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
-> Core (Maybe TypeQ)
-> Core [ConQ]
-> Core [DerivClauseQ]
-> DsM (Core DecQ)
repData (MkC CoreExpr
cxt) (MkC CoreExpr
nm) (Left (MkC CoreExpr
tvs)) (MkC CoreExpr
ksig) (MkC CoreExpr
cons) (MkC CoreExpr
derivs)
  = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core 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] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
dataInstDName [CoreExpr
cxt, CoreExpr
mb_bndrs, CoreExpr
ty, CoreExpr
ksig, CoreExpr
cons, CoreExpr
derivs]

repNewtype :: Core TH.CxtQ -> Core TH.Name
           -> Either (Core [TH.TyVarBndrQ])
                     (Core (Maybe [TH.TyVarBndrQ]), Core TH.TypeQ)
           -> Core (Maybe TH.KindQ) -> Core TH.ConQ -> Core [TH.DerivClauseQ]
           -> DsM (Core TH.DecQ)
repNewtype :: Core CxtQ
-> Core Name
-> Either
     (Core [TyVarBndrQ]) (Core (Maybe [TyVarBndrQ]), Core TypeQ)
-> Core (Maybe TypeQ)
-> Core ConQ
-> Core [DerivClauseQ]
-> DsM (Core DecQ)
repNewtype (MkC CoreExpr
cxt) (MkC CoreExpr
nm) (Left (MkC CoreExpr
tvs)) (MkC CoreExpr
ksig) (MkC CoreExpr
con)
           (MkC CoreExpr
derivs)
  = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core 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] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
newtypeInstDName [CoreExpr
cxt, CoreExpr
mb_bndrs, CoreExpr
ty, CoreExpr
ksig, CoreExpr
con, CoreExpr
derivs]

repTySyn :: Core TH.Name -> Core [TH.TyVarBndrQ]
         -> Core TH.TypeQ -> DsM (Core TH.DecQ)
repTySyn :: Core Name -> Core [TyVarBndrQ] -> Core TypeQ -> DsM (Core DecQ)
repTySyn (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
rhs)
  = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
tySynDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
rhs]

repInst :: Core (Maybe TH.Overlap) ->
           Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
repInst :: Core (Maybe Overlap)
-> Core CxtQ -> Core TypeQ -> Core [DecQ] -> DsM (Core DecQ)
repInst (MkC CoreExpr
o) (MkC CoreExpr
cxt) (MkC CoreExpr
ty) (MkC CoreExpr
ds) = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
instanceWithOverlapDName
                                                              [CoreExpr
o, CoreExpr
cxt, CoreExpr
ty, CoreExpr
ds]

repDerivStrategy :: Maybe (LDerivStrategy GhcRn)
                 -> DsM (Core (Maybe TH.DerivStrategyQ))
repDerivStrategy :: Maybe (LDerivStrategy GhcRn) -> DsM (Core (Maybe DerivStrategyQ))
repDerivStrategy Maybe (LDerivStrategy GhcRn)
mds =
  case Maybe (LDerivStrategy GhcRn)
mds of
    Maybe (LDerivStrategy GhcRn)
Nothing -> DsM (Core (Maybe DerivStrategyQ))
forall a. DsM (Core (Maybe a))
nothing
    Just LDerivStrategy GhcRn
ds ->
      case LDerivStrategy GhcRn -> SrcSpanLess (LDerivStrategy GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LDerivStrategy GhcRn
ds of
        SrcSpanLess (LDerivStrategy GhcRn)
StockStrategy    -> Core DerivStrategyQ -> DsM (Core (Maybe DerivStrategyQ))
forall a. Core a -> DsM (Core (Maybe a))
just (Core DerivStrategyQ -> DsM (Core (Maybe DerivStrategyQ)))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
-> DsM (Core (Maybe DerivStrategyQ))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
repStockStrategy
        SrcSpanLess (LDerivStrategy GhcRn)
AnyclassStrategy -> Core DerivStrategyQ -> DsM (Core (Maybe DerivStrategyQ))
forall a. Core a -> DsM (Core (Maybe a))
just (Core DerivStrategyQ -> DsM (Core (Maybe DerivStrategyQ)))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
-> DsM (Core (Maybe DerivStrategyQ))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
repAnyclassStrategy
        SrcSpanLess (LDerivStrategy GhcRn)
NewtypeStrategy  -> Core DerivStrategyQ -> DsM (Core (Maybe DerivStrategyQ))
forall a. Core a -> DsM (Core (Maybe a))
just (Core DerivStrategyQ -> DsM (Core (Maybe DerivStrategyQ)))
-> IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
-> DsM (Core (Maybe DerivStrategyQ))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
repNewtypeStrategy
        ViaStrategy ty   -> do Core TypeQ
ty' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy (HsImplicitBndrs GhcRn (LHsType GhcRn) -> LHsType GhcRn
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType XViaStrategy GhcRn
HsImplicitBndrs GhcRn (LHsType GhcRn)
ty)
                               Core DerivStrategyQ
via_strat <- Core TypeQ -> IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
repViaStrategy Core TypeQ
ty'
                               Core DerivStrategyQ -> DsM (Core (Maybe DerivStrategyQ))
forall a. Core a -> DsM (Core (Maybe a))
just Core DerivStrategyQ
via_strat
  where
  nothing :: DsM (Core (Maybe a))
nothing = Name -> DsM (Core (Maybe a))
forall a. Name -> DsM (Core (Maybe a))
coreNothing Name
derivStrategyQTyConName
  just :: Core a -> DsM (Core (Maybe a))
just    = Name -> Core a -> DsM (Core (Maybe a))
forall a. Name -> Core a -> DsM (Core (Maybe a))
coreJust    Name
derivStrategyQTyConName

repStockStrategy :: DsM (Core TH.DerivStrategyQ)
repStockStrategy :: IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
repStockStrategy = Name
-> [CoreExpr]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
stockStrategyName []

repAnyclassStrategy :: DsM (Core TH.DerivStrategyQ)
repAnyclassStrategy :: IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
repAnyclassStrategy = Name
-> [CoreExpr]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
anyclassStrategyName []

repNewtypeStrategy :: DsM (Core TH.DerivStrategyQ)
repNewtypeStrategy :: IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
repNewtypeStrategy = Name
-> [CoreExpr]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
newtypeStrategyName []

repViaStrategy :: Core TH.TypeQ -> DsM (Core TH.DerivStrategyQ)
repViaStrategy :: Core TypeQ -> IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
repViaStrategy (MkC CoreExpr
t) = Name
-> [CoreExpr]
-> IOEnv (Env DsGblEnv DsLclEnv) (Core DerivStrategyQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
viaStrategyName [CoreExpr
t]

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


repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndrQ]
         -> Core [TH.FunDep] -> Core [TH.DecQ]
         -> DsM (Core TH.DecQ)
repClass :: Core CxtQ
-> Core Name
-> Core [TyVarBndrQ]
-> Core [FunDep]
-> Core [DecQ]
-> DsM (Core DecQ)
repClass (MkC CoreExpr
cxt) (MkC CoreExpr
cls) (MkC CoreExpr
tvs) (MkC CoreExpr
fds) (MkC CoreExpr
ds)
  = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
classDName [CoreExpr
cxt, CoreExpr
cls, CoreExpr
tvs, CoreExpr
fds, CoreExpr
ds]

repDeriv :: Core (Maybe TH.DerivStrategyQ)
         -> Core TH.CxtQ -> Core TH.TypeQ
         -> DsM (Core TH.DecQ)
repDeriv :: Core (Maybe DerivStrategyQ)
-> Core CxtQ -> Core TypeQ -> DsM (Core DecQ)
repDeriv (MkC CoreExpr
ds) (MkC CoreExpr
cxt) (MkC CoreExpr
ty)
  = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
standaloneDerivWithStrategyDName [CoreExpr
ds, CoreExpr
cxt, CoreExpr
ty]

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

repPragSpec :: Core TH.Name -> Core TH.TypeQ -> Core TH.Phases
            -> DsM (Core TH.DecQ)
repPragSpec :: Core Name -> Core TypeQ -> Core Phases -> DsM (Core DecQ)
repPragSpec (MkC CoreExpr
nm) (MkC CoreExpr
ty) (MkC CoreExpr
phases)
  = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
pragSpecDName [CoreExpr
nm, CoreExpr
ty, CoreExpr
phases]

repPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.Inline
               -> Core TH.Phases -> DsM (Core TH.DecQ)
repPragSpecInl :: Core Name
-> Core TypeQ -> Core Inline -> Core Phases -> DsM (Core DecQ)
repPragSpecInl (MkC CoreExpr
nm) (MkC CoreExpr
ty) (MkC CoreExpr
inline) (MkC CoreExpr
phases)
  = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
pragSpecInlDName [CoreExpr
nm, CoreExpr
ty, CoreExpr
inline, CoreExpr
phases]

repPragSpecInst :: Core TH.TypeQ -> DsM (Core TH.DecQ)
repPragSpecInst :: Core TypeQ -> DsM (Core DecQ)
repPragSpecInst (MkC CoreExpr
ty) = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
pragSpecInstDName [CoreExpr
ty]

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

repPragRule :: Core String -> Core (Maybe [TH.TyVarBndrQ])
            -> Core [TH.RuleBndrQ] -> Core TH.ExpQ -> Core TH.ExpQ
            -> Core TH.Phases -> DsM (Core TH.DecQ)
repPragRule :: Core String
-> Core (Maybe [TyVarBndrQ])
-> Core [RuleBndrQ]
-> Core ExpQ
-> Core ExpQ
-> Core Phases
-> DsM (Core DecQ)
repPragRule (MkC CoreExpr
nm) (MkC CoreExpr
ty_bndrs) (MkC CoreExpr
tm_bndrs) (MkC CoreExpr
lhs) (MkC CoreExpr
rhs) (MkC CoreExpr
phases)
  = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
pragRuleDName [CoreExpr
nm, CoreExpr
ty_bndrs, CoreExpr
tm_bndrs, CoreExpr
lhs, CoreExpr
rhs, CoreExpr
phases]

repPragAnn :: Core TH.AnnTarget -> Core TH.ExpQ -> DsM (Core TH.DecQ)
repPragAnn :: Core AnnTarget -> Core ExpQ -> DsM (Core DecQ)
repPragAnn (MkC CoreExpr
targ) (MkC CoreExpr
e) = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
pragAnnDName [CoreExpr
targ, CoreExpr
e]

repTySynInst :: Core TH.TySynEqnQ -> DsM (Core TH.DecQ)
repTySynInst :: Core TySynEqnQ -> DsM (Core DecQ)
repTySynInst (MkC CoreExpr
eqn)
    = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
tySynInstDName [CoreExpr
eqn]

repDataFamilyD :: Core TH.Name -> Core [TH.TyVarBndrQ]
               -> Core (Maybe TH.KindQ) -> DsM (Core TH.DecQ)
repDataFamilyD :: Core Name
-> Core [TyVarBndrQ] -> Core (Maybe TypeQ) -> DsM (Core DecQ)
repDataFamilyD (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
kind)
    = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
dataFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
kind]

repOpenFamilyD :: Core TH.Name
               -> Core [TH.TyVarBndrQ]
               -> Core TH.FamilyResultSigQ
               -> Core (Maybe TH.InjectivityAnn)
               -> DsM (Core TH.DecQ)
repOpenFamilyD :: Core Name
-> Core [TyVarBndrQ]
-> Core FamilyResultSigQ
-> Core (Maybe InjectivityAnn)
-> DsM (Core DecQ)
repOpenFamilyD (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
result) (MkC CoreExpr
inj)
    = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
openTypeFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
result, CoreExpr
inj]

repClosedFamilyD :: Core TH.Name
                 -> Core [TH.TyVarBndrQ]
                 -> Core TH.FamilyResultSigQ
                 -> Core (Maybe TH.InjectivityAnn)
                 -> Core [TH.TySynEqnQ]
                 -> DsM (Core TH.DecQ)
repClosedFamilyD :: Core Name
-> Core [TyVarBndrQ]
-> Core FamilyResultSigQ
-> Core (Maybe InjectivityAnn)
-> Core [TySynEqnQ]
-> DsM (Core DecQ)
repClosedFamilyD (MkC CoreExpr
nm) (MkC CoreExpr
tvs) (MkC CoreExpr
res) (MkC CoreExpr
inj) (MkC CoreExpr
eqns)
    = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
closedTypeFamilyDName [CoreExpr
nm, CoreExpr
tvs, CoreExpr
res, CoreExpr
inj, CoreExpr
eqns]

repTySynEqn :: Core (Maybe [TH.TyVarBndrQ]) ->
               Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TySynEqnQ)
repTySynEqn :: Core (Maybe [TyVarBndrQ])
-> Core TypeQ
-> Core TypeQ
-> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
repTySynEqn (MkC CoreExpr
mb_bndrs) (MkC CoreExpr
lhs) (MkC CoreExpr
rhs)
  = Name
-> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) (Core TySynEqnQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
tySynEqnName [CoreExpr
mb_bndrs, CoreExpr
lhs, CoreExpr
rhs]

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

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

repProto :: Name -> Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
repProto :: Name -> Core Name -> Core TypeQ -> DsM (Core DecQ)
repProto Name
mk_sig (MkC CoreExpr
s) (MkC CoreExpr
ty) = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
mk_sig [CoreExpr
s, CoreExpr
ty]

repImplicitParamBind :: Core String -> Core TH.ExpQ -> DsM (Core TH.DecQ)
repImplicitParamBind :: Core String -> Core ExpQ -> DsM (Core DecQ)
repImplicitParamBind (MkC CoreExpr
n) (MkC CoreExpr
e) = Name -> [CoreExpr] -> DsM (Core DecQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
implicitParamBindDName [CoreExpr
n, CoreExpr
e]

repCtxt :: Core [TH.PredQ] -> DsM (Core TH.CxtQ)
repCtxt :: Core [TypeQ] -> DsM (Core CxtQ)
repCtxt (MkC CoreExpr
tys) = Name -> [CoreExpr] -> DsM (Core CxtQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
cxtName [CoreExpr
tys]

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

repGadtDataCons :: [Located Name]
                -> HsConDeclDetails GhcRn
                -> LHsType GhcRn
                -> DsM (Core TH.ConQ)
repGadtDataCons :: [Located Name]
-> HsConDeclDetails GhcRn -> LHsType GhcRn -> DsM (Core ConQ)
repGadtDataCons [Located Name]
cons HsConDeclDetails GhcRn
details LHsType GhcRn
res_ty
    = do [Core Name]
cons' <- (Located Name -> DsM (Core Name))
-> [Located Name] -> IOEnv (Env DsGblEnv DsLclEnv) [Core Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located Name -> DsM (Core Name)
lookupLOcc [Located Name]
cons -- See Note [Binders and occurrences]
         HsConDeclDetails GhcRn
-> Maybe (LHsType GhcRn) -> [Core Name] -> DsM (Core ConQ)
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]
          -> DsM (Core TH.ConQ)
repConstr :: HsConDeclDetails GhcRn
-> Maybe (LHsType GhcRn) -> [Core Name] -> DsM (Core ConQ)
repConstr (PrefixCon HsContext GhcRn
ps) Maybe (LHsType GhcRn)
Nothing [Core Name
con]
    = do Core [BangTypeQ]
arg_tys  <- Name
-> (LHsType GhcRn -> DsM (Core BangTypeQ))
-> HsContext GhcRn
-> DsM (Core [BangTypeQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
bangTypeQTyConName LHsType GhcRn -> DsM (Core BangTypeQ)
repBangTy HsContext GhcRn
ps
         Name -> [CoreExpr] -> DsM (Core ConQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
normalCName [Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC Core Name
con, Core [BangTypeQ] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [BangTypeQ]
arg_tys]

repConstr (PrefixCon HsContext GhcRn
ps) (Just LHsType GhcRn
res_ty) [Core Name]
cons
    = do Core [BangTypeQ]
arg_tys     <- Name
-> (LHsType GhcRn -> DsM (Core BangTypeQ))
-> HsContext GhcRn
-> DsM (Core [BangTypeQ])
forall a b. Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
bangTypeQTyConName LHsType GhcRn -> DsM (Core BangTypeQ)
repBangTy HsContext GhcRn
ps
         Core TypeQ
res_ty' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
res_ty
         Name -> [CoreExpr] -> DsM (Core ConQ)
forall a. Name -> [CoreExpr] -> DsM (Core 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 [BangTypeQ] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [BangTypeQ]
arg_tys, Core TypeQ -> CoreExpr
forall a. Core a -> CoreExpr
unC Core TypeQ
res_ty']

repConstr (RecCon Located [LConDeclField GhcRn]
ips) Maybe (LHsType GhcRn)
resTy [Core Name]
cons
    = do [Core Any]
args     <- (LConDeclField GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) [Core Any])
-> [LConDeclField GhcRn]
-> IOEnv (Env DsGblEnv DsLclEnv) [Core Any]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM LConDeclField GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) [Core Any]
forall l a.
GenLocated l (ConDeclField GhcRn)
-> IOEnv (Env DsGblEnv DsLclEnv) [Core a]
rep_ip (Located [LConDeclField GhcRn]
-> SrcSpanLess (Located [LConDeclField GhcRn])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [LConDeclField GhcRn]
ips)
         Core [Any]
arg_vtys <- Name -> [Core Any] -> DsM (Core [Any])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
varBangTypeQTyConName [Core Any]
args
         case Maybe (LHsType GhcRn)
resTy of
           Maybe (LHsType GhcRn)
Nothing -> Name -> [CoreExpr] -> DsM (Core ConQ)
forall a. Name -> [CoreExpr] -> DsM (Core 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 [Any] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [Any]
arg_vtys]
           Just LHsType GhcRn
res_ty -> do
             Core TypeQ
res_ty' <- LHsType GhcRn -> DsM (Core TypeQ)
repLTy LHsType GhcRn
res_ty
             Name -> [CoreExpr] -> DsM (Core ConQ)
forall a. Name -> [CoreExpr] -> DsM (Core 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 [Any] -> CoreExpr
forall a. Core a -> CoreExpr
unC Core [Any]
arg_vtys,
                                Core TypeQ -> CoreExpr
forall a. Core a -> CoreExpr
unC Core TypeQ
res_ty']

    where
      rep_ip :: GenLocated l (ConDeclField GhcRn)
-> IOEnv (Env DsGblEnv DsLclEnv) [Core a]
rep_ip (L l
_ ConDeclField GhcRn
ip) = (LFieldOcc GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (Core a))
-> [LFieldOcc GhcRn] -> IOEnv (Env DsGblEnv DsLclEnv) [Core a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (LHsType GhcRn
-> LFieldOcc GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (Core a)
forall a. LHsType GhcRn -> LFieldOcc GhcRn -> DsM (Core a)
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 -> DsM (Core a)
      rep_one_ip :: LHsType GhcRn -> LFieldOcc GhcRn -> DsM (Core a)
rep_one_ip LHsType GhcRn
t LFieldOcc GhcRn
n = do { MkC CoreExpr
v  <- Name -> DsM (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 -> SrcSpanLess (LFieldOcc GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LFieldOcc GhcRn
n)
                          ; MkC CoreExpr
ty <- LHsType GhcRn -> DsM (Core BangTypeQ)
repBangTy  LHsType GhcRn
t
                          ; Name -> [CoreExpr] -> DsM (Core a)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
varBangTypeName [CoreExpr
v,CoreExpr
ty] }

repConstr (InfixCon LHsType GhcRn
st1 LHsType GhcRn
st2) Maybe (LHsType GhcRn)
Nothing [Core Name
con]
    = do Core BangTypeQ
arg1 <- LHsType GhcRn -> DsM (Core BangTypeQ)
repBangTy LHsType GhcRn
st1
         Core BangTypeQ
arg2 <- LHsType GhcRn -> DsM (Core BangTypeQ)
repBangTy LHsType GhcRn
st2
         Name -> [CoreExpr] -> DsM (Core ConQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
infixCName [Core BangTypeQ -> CoreExpr
forall a. Core a -> CoreExpr
unC Core BangTypeQ
arg1, Core Name -> CoreExpr
forall a. Core a -> CoreExpr
unC Core Name
con, Core BangTypeQ -> CoreExpr
forall a. Core a -> CoreExpr
unC Core BangTypeQ
arg2]

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

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

repTForall :: Core [TH.TyVarBndrQ] -> Core TH.CxtQ -> Core TH.TypeQ
           -> DsM (Core TH.TypeQ)
repTForall :: Core [TyVarBndrQ] -> Core CxtQ -> Core TypeQ -> DsM (Core TypeQ)
repTForall (MkC CoreExpr
tvars) (MkC CoreExpr
ctxt) (MkC CoreExpr
ty)
    = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
forallTName [CoreExpr
tvars, CoreExpr
ctxt, CoreExpr
ty]

repTForallVis :: Core [TH.TyVarBndrQ] -> Core TH.TypeQ
              -> DsM (Core TH.TypeQ)
repTForallVis :: Core [TyVarBndrQ] -> Core TypeQ -> DsM (Core TypeQ)
repTForallVis (MkC CoreExpr
tvars) (MkC CoreExpr
ty) = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
forallVisTName [CoreExpr
tvars, CoreExpr
ty]

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

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

repTappKind :: Core TH.TypeQ -> Core TH.KindQ -> DsM (Core TH.TypeQ)
repTappKind :: Core TypeQ -> Core TypeQ -> DsM (Core TypeQ)
repTappKind (MkC CoreExpr
ty) (MkC CoreExpr
ki) = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
appKindTName [CoreExpr
ty,CoreExpr
ki]

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

repTSig :: Core TH.TypeQ -> Core TH.KindQ -> DsM (Core TH.TypeQ)
repTSig :: Core TypeQ -> Core TypeQ -> DsM (Core TypeQ)
repTSig (MkC CoreExpr
ty) (MkC CoreExpr
ki) = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
sigTName [CoreExpr
ty, CoreExpr
ki]

repTequality :: DsM (Core TH.TypeQ)
repTequality :: DsM (Core TypeQ)
repTequality = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
equalityTName []

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

repTLit :: Core TH.TyLitQ -> DsM (Core TH.TypeQ)
repTLit :: Core TyLitQ -> DsM (Core TypeQ)
repTLit (MkC CoreExpr
lit) = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
litTName [CoreExpr
lit]

repTWildCard :: DsM (Core TH.TypeQ)
repTWildCard :: DsM (Core TypeQ)
repTWildCard = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
wildCardTName []

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

repTStar :: DsM (Core TH.TypeQ)
repTStar :: DsM (Core TypeQ)
repTStar = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
starKName []

repTConstraint :: DsM (Core TH.TypeQ)
repTConstraint :: DsM (Core TypeQ)
repTConstraint = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
constraintKName []

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

repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
repNamedTyCon :: Core Name -> DsM (Core TypeQ)
repNamedTyCon (MkC CoreExpr
s) = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
conTName [CoreExpr
s]

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

repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
-- Note: not Core Int; it's easier to be direct here
repTupleTyCon :: Int -> DsM (Core TypeQ)
repTupleTyCon Int
i = do DynFlags
dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
                     Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
tupleTName [DynFlags -> Int -> CoreExpr
mkIntExprInt DynFlags
dflags Int
i]

repUnboxedTupleTyCon :: Int -> DsM (Core TH.TypeQ)
-- Note: not Core Int; it's easier to be direct here
repUnboxedTupleTyCon :: Int -> DsM (Core TypeQ)
repUnboxedTupleTyCon Int
i = do DynFlags
dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
                            Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
unboxedTupleTName [DynFlags -> Int -> CoreExpr
mkIntExprInt DynFlags
dflags Int
i]

repUnboxedSumTyCon :: TH.SumArity -> DsM (Core TH.TypeQ)
-- Note: not Core TH.SumArity; it's easier to be direct here
repUnboxedSumTyCon :: Int -> DsM (Core TypeQ)
repUnboxedSumTyCon Int
arity = do DynFlags
dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
                              Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
unboxedSumTName [DynFlags -> Int -> CoreExpr
mkIntExprInt DynFlags
dflags Int
arity]

repArrowTyCon :: DsM (Core TH.TypeQ)
repArrowTyCon :: DsM (Core TypeQ)
repArrowTyCon = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
arrowTName []

repListTyCon :: DsM (Core TH.TypeQ)
repListTyCon :: DsM (Core TypeQ)
repListTyCon = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
listTName []

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

repPromotedTupleTyCon :: Int -> DsM (Core TH.TypeQ)
repPromotedTupleTyCon :: Int -> DsM (Core TypeQ)
repPromotedTupleTyCon Int
i = do DynFlags
dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
                             Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
promotedTupleTName [DynFlags -> Int -> CoreExpr
mkIntExprInt DynFlags
dflags Int
i]

repPromotedNilTyCon :: DsM (Core TH.TypeQ)
repPromotedNilTyCon :: DsM (Core TypeQ)
repPromotedNilTyCon = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
promotedNilTName []

repPromotedConsTyCon :: DsM (Core TH.TypeQ)
repPromotedConsTyCon :: DsM (Core TypeQ)
repPromotedConsTyCon = Name -> [CoreExpr] -> DsM (Core TypeQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
promotedConsTName []

------------ TyVarBndrs -------------------

repPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndrQ)
repPlainTV :: Core Name -> DsM (Core TyVarBndrQ)
repPlainTV (MkC CoreExpr
nm) = Name -> [CoreExpr] -> DsM (Core TyVarBndrQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
plainTVName [CoreExpr
nm]

repKindedTV :: Core TH.Name -> Core TH.KindQ -> DsM (Core TH.TyVarBndrQ)
repKindedTV :: Core Name -> Core TypeQ -> DsM (Core TyVarBndrQ)
repKindedTV (MkC CoreExpr
nm) (MkC CoreExpr
ki) = Name -> [CoreExpr] -> DsM (Core TyVarBndrQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
kindedTVName [CoreExpr
nm, CoreExpr
ki]

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

repNoSig :: DsM (Core TH.FamilyResultSigQ)
repNoSig :: DsM (Core FamilyResultSigQ)
repNoSig = Name -> [CoreExpr] -> DsM (Core FamilyResultSigQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
noSigName []

repKindSig :: Core TH.KindQ -> DsM (Core TH.FamilyResultSigQ)
repKindSig :: Core TypeQ -> DsM (Core FamilyResultSigQ)
repKindSig (MkC CoreExpr
ki) = Name -> [CoreExpr] -> DsM (Core FamilyResultSigQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
kindSigName [CoreExpr
ki]

repTyVarSig :: Core TH.TyVarBndrQ -> DsM (Core TH.FamilyResultSigQ)
repTyVarSig :: Core TyVarBndrQ -> DsM (Core FamilyResultSigQ)
repTyVarSig (MkC CoreExpr
bndr) = Name -> [CoreExpr] -> DsM (Core FamilyResultSigQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
tyVarSigName [CoreExpr
bndr]

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

repLiteral :: HsLit GhcRn -> DsM (Core TH.Lit)
repLiteral :: HsLit GhcRn -> DsM (Core Lit)
repLiteral (HsStringPrim XHsStringPrim GhcRn
_ ByteString
bs)
  = do DynFlags
dflags   <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       Type
word8_ty <- Name -> DsM 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
                                  [DynFlags -> Integer -> CoreExpr
forall b. DynFlags -> Integer -> Expr b
mkWordLit DynFlags
dflags (Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
w8)]) [Word8]
w8s
       Name -> [CoreExpr] -> DsM (Core Lit)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 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 -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_integer Integer
i
                   HsWordPrim XHsWordPrim GhcRn
_ Integer
w   -> Integer -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_integer Integer
w
                   HsInt XHsInt GhcRn
_ IntegralLit
i        -> Integer -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_integer (IntegralLit -> Integer
il_value IntegralLit
i)
                   HsFloatPrim XHsFloatPrim GhcRn
_ FractionalLit
r  -> FractionalLit -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_rational FractionalLit
r
                   HsDoublePrim XHsDoublePrim GhcRn
_ FractionalLit
r -> FractionalLit -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_rational FractionalLit
r
                   HsCharPrim XHsCharPrim GhcRn
_ Char
c   -> Char -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_char Char
c
                   HsLit GhcRn
_ -> HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return HsLit GhcRn
lit
       CoreExpr
lit_expr <- HsLit GhcRn -> DsM CoreExpr
dsLit HsLit GhcRn
lit'
       case Maybe Name
mb_lit_name of
          Just Name
lit_name -> Name -> [CoreExpr] -> DsM (Core Lit)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
lit_name [CoreExpr
lit_expr]
          Maybe Name
Nothing -> String -> SDoc -> DsM (Core Lit)
forall a. String -> SDoc -> DsM 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 -> DsM (HsLit GhcRn)
mk_integer :: Integer -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_integer  Integer
i = do Type
integer_ty <- Name -> DsM Type
lookupType Name
integerTyConName
                   HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn))
-> HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (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
integer_ty

mk_rational :: FractionalLit -> DsM (HsLit GhcRn)
mk_rational :: FractionalLit -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_rational FractionalLit
r = do Type
rat_ty <- Name -> DsM Type
lookupType Name
rationalTyConName
                   HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn))
-> HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
forall a b. (a -> b) -> a -> b
$ XHsRat GhcRn -> FractionalLit -> Type -> HsLit GhcRn
forall x. XHsRat x -> FractionalLit -> Type -> HsLit x
HsRat XHsRat GhcRn
NoExtField
noExtField FractionalLit
r Type
rat_ty
mk_string :: FastString -> DsM (HsLit GhcRn)
mk_string :: CLabelString -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_string CLabelString
s = HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn))
-> HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (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 -> DsM (HsLit GhcRn)
mk_char :: Char -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_char Char
c = HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn))
-> HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) (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 -> DsM (Core TH.Lit)
repOverloadedLiteral :: HsOverLit GhcRn -> DsM (Core Lit)
repOverloadedLiteral (OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = OverLitVal
val})
  = do { HsLit GhcRn
lit <- OverLitVal -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_lit OverLitVal
val; HsLit GhcRn -> DsM (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
repOverloadedLiteral (XOverLit XXOverLit GhcRn
nec) = NoExtCon -> DsM (Core Lit)
forall a. NoExtCon -> a
noExtCon XXOverLit GhcRn
NoExtCon
nec

mk_lit :: OverLitVal -> DsM (HsLit GhcRn)
mk_lit :: OverLitVal -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_lit (HsIntegral IntegralLit
i)     = Integer -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_integer  (IntegralLit -> Integer
il_value IntegralLit
i)
mk_lit (HsFractional FractionalLit
f)   = FractionalLit -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_rational FractionalLit
f
mk_lit (HsIsString SourceText
_ CLabelString
s)   = CLabelString -> IOEnv (Env DsGblEnv DsLclEnv) (HsLit GhcRn)
mk_string   CLabelString
s

repNameS :: Core String -> DsM (Core TH.Name)
repNameS :: Core String -> DsM (Core Name)
repNameS (MkC CoreExpr
name) = Name -> [CoreExpr] -> DsM (Core Name)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
mkNameSName [CoreExpr
name]

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

repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
repGensym :: Core String -> DsM (Core (Q Name))
repGensym (MkC CoreExpr
lit_str) = Name -> [CoreExpr] -> DsM (Core (Q Name))
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
newNameName [CoreExpr
lit_str]

repBindQ :: Type -> Type        -- a and b
         -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
repBindQ :: Type -> Type -> Core (Q a) -> Core (a -> Q b) -> DsM (Core (Q b))
repBindQ Type
ty_a Type
ty_b (MkC CoreExpr
x) (MkC CoreExpr
y)
  = Name -> [CoreExpr] -> DsM (Core (Q b))
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
bindQName [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]

repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
repSequenceQ :: Type -> Core [Q a] -> DsM (Core (Q [a]))
repSequenceQ Type
ty_a (MkC CoreExpr
list)
  = Name -> [CoreExpr] -> DsM (Core (Q [a]))
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
sequenceQName [Type -> CoreExpr
forall b. Type -> Expr b
Type Type
ty_a, CoreExpr
list]

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

repOverLabel :: FastString -> DsM (Core TH.ExpQ)
repOverLabel :: CLabelString -> DsM (Core ExpQ)
repOverLabel CLabelString
fs = do
                    (MkC CoreExpr
s) <- String -> DsM (Core String)
coreStringLit (String -> DsM (Core String)) -> String -> DsM (Core String)
forall a b. (a -> b) -> a -> b
$ CLabelString -> String
unpackFS CLabelString
fs
                    Name -> [CoreExpr] -> DsM (Core ExpQ)
forall a. Name -> [CoreExpr] -> DsM (Core a)
rep2 Name
labelEName [CoreExpr
s]


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

repList :: Name -> (a  -> DsM (Core b))
                    -> [a] -> DsM (Core [b])
repList :: Name -> (a -> DsM (Core b)) -> [a] -> DsM (Core [b])
repList Name
tc_name a -> DsM (Core b)
f [a]
args
  = do { [Core b]
args1 <- (a -> DsM (Core b))
-> [a] -> IOEnv (Env DsGblEnv DsLclEnv) [Core b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> DsM (Core b)
f [a]
args
       ; Name -> [Core b] -> DsM (Core [b])
forall a. Name -> [Core a] -> DsM (Core [a])
coreList Name
tc_name [Core b]
args1 }

coreList :: Name    -- Of the TyCon of the element type
         -> [Core a] -> DsM (Core [a])
coreList :: Name -> [Core a] -> DsM (Core [a])
coreList Name
tc_name [Core a]
es
  = do { Type
elt_ty <- Name -> DsM Type
lookupType Name
tc_name; Core [a] -> DsM (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' :: 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 :: [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 :: String -> DsM (Core String)
coreStringLit :: String -> DsM (Core String)
coreStringLit String
s = do { CoreExpr
z <- String -> DsM CoreExpr
forall (m :: * -> *). MonadThings m => String -> m CoreExpr
mkStringExpr String
s; Core String -> DsM (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 -> DsM (Core b))
                    -> Maybe a -> DsM (Core (Maybe b))
repMaybe :: Name -> (a -> DsM (Core b)) -> Maybe a -> DsM (Core (Maybe b))
repMaybe Name
tc_name a -> DsM (Core b)
_ Maybe a
Nothing   = Name -> DsM (Core (Maybe b))
forall a. Name -> DsM (Core (Maybe a))
coreNothing Name
tc_name
repMaybe Name
tc_name a -> DsM (Core b)
f (Just a
es) = Name -> Core b -> DsM (Core (Maybe b))
forall a. Name -> Core a -> DsM (Core (Maybe a))
coreJust Name
tc_name (Core b -> DsM (Core (Maybe b)))
-> DsM (Core b) -> DsM (Core (Maybe b))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> DsM (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
            -> DsM (Core (Maybe a))
coreNothing :: Name -> DsM (Core (Maybe a))
coreNothing Name
tc_name =
    do { Type
elt_ty <- Name -> DsM Type
lookupType Name
tc_name; Core (Maybe a) -> DsM (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' :: 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 -> DsM (Core (Maybe a))
coreJust :: Name -> Core a -> DsM (Core (Maybe a))
coreJust Name
tc_name Core a
es
  = do { Type
elt_ty <- Name -> DsM Type
lookupType Name
tc_name; Core (Maybe a) -> DsM (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' :: 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 ------------------

repMaybeList :: Name -> (a -> DsM (Core b))
                        -> Maybe [a] -> DsM (Core (Maybe [b]))
repMaybeList :: Name -> (a -> DsM (Core b)) -> Maybe [a] -> DsM (Core (Maybe [b]))
repMaybeList Name
tc_name a -> DsM (Core b)
_ Maybe [a]
Nothing = Name -> DsM (Core (Maybe [b]))
forall a. Name -> DsM (Core (Maybe [a]))
coreNothingList Name
tc_name
repMaybeList Name
tc_name a -> DsM (Core b)
f (Just [a]
args)
  = do { Type
elt_ty <- Name -> DsM Type
lookupType Name
tc_name
       ; [Core b]
args1 <- (a -> DsM (Core b))
-> [a] -> IOEnv (Env DsGblEnv DsLclEnv) [Core b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> DsM (Core b)
f [a]
args
       ; Core (Maybe [b]) -> DsM (Core (Maybe [b]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Core (Maybe [b]) -> DsM (Core (Maybe [b])))
-> Core (Maybe [b]) -> DsM (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 :: Name -> DsM (Core (Maybe [a]))
coreNothingList :: Name -> DsM (Core (Maybe [a]))
coreNothingList Name
tc_name
  = do { Type
elt_ty <- Name -> DsM Type
lookupType Name
tc_name
       ; Core (Maybe [a]) -> DsM (Core (Maybe [a]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Core (Maybe [a]) -> DsM (Core (Maybe [a])))
-> Core (Maybe [a]) -> 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) }

coreJustList :: Name -> Core [a] -> DsM (Core (Maybe [a]))
coreJustList :: Name -> Core [a] -> DsM (Core (Maybe [a]))
coreJustList Name
tc_name Core [a]
args
  = do { Type
elt_ty <- Name -> DsM Type
lookupType Name
tc_name
       ; Core (Maybe [a]) -> DsM (Core (Maybe [a]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Core (Maybe [a]) -> DsM (Core (Maybe [a])))
-> Core (Maybe [a]) -> DsM (Core (Maybe [a]))
forall a b. (a -> b) -> a -> b
$ Type -> Core [a] -> Core (Maybe [a])
forall a. Type -> Core a -> Core (Maybe a)
coreJust' (Type -> Type
mkListTy Type
elt_ty) Core [a]
args }

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

coreIntLit :: Int -> DsM (Core Int)
coreIntLit :: Int -> DsM (Core Int)
coreIntLit Int
i = do DynFlags
dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
                  Core Int -> DsM (Core Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Core Int
forall a. CoreExpr -> Core a
MkC (DynFlags -> Int -> CoreExpr
mkIntExprInt DynFlags
dflags Int
i))

coreIntegerLit :: Integer -> DsM (Core Integer)
coreIntegerLit :: Integer -> DsM (Core Integer)
coreIntegerLit Integer
i = (CoreExpr -> Core Integer) -> DsM CoreExpr -> DsM (Core Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CoreExpr -> Core Integer
forall a. CoreExpr -> Core a
MkC (Integer -> DsM CoreExpr
forall (m :: * -> *). MonadThings m => Integer -> m 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 -> DsM a
notHandledL :: SrcSpan -> String -> SDoc -> DsM a
notHandledL SrcSpan
loc String
what SDoc
doc
  | SrcSpan -> Bool
isGoodSrcSpan SrcSpan
loc
  = SrcSpan -> DsM a -> DsM a
forall a. SrcSpan -> DsM a -> DsM a
putSrcSpanDs SrcSpan
loc (DsM a -> DsM a) -> DsM a -> DsM a
forall a b. (a -> b) -> a -> b
$ String -> SDoc -> DsM a
forall a. String -> SDoc -> DsM a
notHandled String
what SDoc
doc
  | Bool
otherwise
  = String -> SDoc -> DsM a
forall a. String -> SDoc -> DsM a
notHandled String
what SDoc
doc

notHandled :: String -> SDoc -> DsM a
notHandled :: String -> SDoc -> DsM a
notHandled String
what SDoc
doc = SDoc -> DsM 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