{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE ViewPatterns #-}

module PyF.Internal.Meta (toExp, baseDynFlags, translateTHtoGHCExt) where

#if MIN_VERSION_ghc(9,0,0)
import GHC.Hs.Type (HsWildCardBndrs (..), HsType (..))
#elif MIN_VERSION_ghc(8,10,0)
import GHC.Hs.Types (HsWildCardBndrs (..), HsType (..))
#else
import HsTypes (HsWildCardBndrs (..), HsType (..))
#endif

#if MIN_VERSION_ghc(8,10,0)
import GHC.Hs.Expr as Expr
import GHC.Hs.Extension as Ext
import GHC.Hs.Pat as Pat
import GHC.Hs.Lit
#else
import HsExpr as Expr
import HsExtension as Ext
import HsPat as Pat
import HsLit
#endif

import qualified Data.ByteString as B
import qualified Language.Haskell.TH.Syntax as GhcTH
import qualified Language.Haskell.TH.Syntax as TH
import PyF.Internal.ParserEx (fakeLlvmConfig, fakeSettings)

#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Data.FastString
#if MIN_VERSION_ghc(9,2,0)
import GHC.Utils.Outputable (ppr)
import GHC.Types.Basic (Boxity(..))
import GHC.Types.SourceText (il_value, rationalFromFractionalLit)
import GHC.Driver.Ppr (showSDocDebug)
#else
import GHC.Utils.Outputable (ppr, showSDocDebug)
import GHC.Types.Basic (il_value, fl_value, Boxity(..))
#endif
import GHC.Driver.Session (DynFlags, xopt_set, defaultDynFlags)
import qualified GHC.Unit.Module as Module
#else
import SrcLoc
import Name
import RdrName
import FastString
import Outputable (ppr, showSDocDebug)
import BasicTypes (il_value, fl_value, Boxity(..))
import DynFlags (DynFlags, xopt_set, defaultDynFlags)
import qualified Module
#endif


#if MIN_VERSION_ghc(9,2,0)
-- TODO: why this disapears in GHC >= 9.2?
fl_value = rationalFromFractionalLit
#endif

toLit :: HsLit GhcPs -> TH.Lit
toLit :: HsLit GhcPs -> Lit
toLit (HsChar XHsChar GhcPs
_ Char
c) = Char -> Lit
TH.CharL Char
c
toLit (HsCharPrim XHsCharPrim GhcPs
_ Char
c) = Char -> Lit
TH.CharPrimL Char
c
toLit (HsString XHsString GhcPs
_ FastString
s) = String -> Lit
TH.StringL (FastString -> String
unpackFS FastString
s)
toLit (HsStringPrim XHsStringPrim GhcPs
_ ByteString
s) = [Word8] -> Lit
TH.StringPrimL (ByteString -> [Word8]
B.unpack ByteString
s)
toLit (HsInt XHsInt GhcPs
_ IntegralLit
i) = Integer -> Lit
TH.IntegerL (IntegralLit -> Integer
il_value IntegralLit
i)
toLit (HsIntPrim XHsIntPrim GhcPs
_ Integer
i) = Integer -> Lit
TH.IntPrimL Integer
i
toLit (HsWordPrim XHsWordPrim GhcPs
_ Integer
i) = Integer -> Lit
TH.WordPrimL Integer
i
toLit (HsInt64Prim XHsInt64Prim GhcPs
_ Integer
i) = Integer -> Lit
TH.IntegerL Integer
i
toLit (HsWord64Prim XHsWord64Prim GhcPs
_ Integer
i) = Integer -> Lit
TH.WordPrimL Integer
i
toLit (HsInteger XHsInteger GhcPs
_ Integer
i Type
_) = Integer -> Lit
TH.IntegerL Integer
i
toLit (HsRat XHsRat GhcPs
_ FractionalLit
f Type
_) = Rational -> Lit
TH.FloatPrimL (FractionalLit -> Rational
fl_value FractionalLit
f)
toLit (HsFloatPrim XHsFloatPrim GhcPs
_ FractionalLit
f) = Rational -> Lit
TH.FloatPrimL (FractionalLit -> Rational
fl_value FractionalLit
f)
toLit (HsDoublePrim XHsDoublePrim GhcPs
_ FractionalLit
f) = Rational -> Lit
TH.DoublePrimL (FractionalLit -> Rational
fl_value FractionalLit
f)

#if !MIN_VERSION_ghc(9,0,0)
toLit (XLit XXLit GhcPs
_) = String -> String -> Lit
forall e a. Show e => String -> e -> a
noTH String
"toLit" String
"XLit"
#endif

toLit' :: OverLitVal -> TH.Lit
toLit' :: OverLitVal -> Lit
toLit' (HsIntegral IntegralLit
i) = Integer -> Lit
TH.IntegerL (IntegralLit -> Integer
il_value IntegralLit
i)
toLit' (HsFractional FractionalLit
f) = Rational -> Lit
TH.RationalL (FractionalLit -> Rational
fl_value FractionalLit
f)
toLit' (HsIsString SourceText
_ FastString
fs) = String -> Lit
TH.StringL (FastString -> String
unpackFS FastString
fs)

toType :: HsType GhcPs -> TH.Type
toType :: HsType GhcPs -> Type
toType (HsWildCardTy XWildCardTy GhcPs
_) = Type
TH.WildCardT
toType (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ Located (IdP GhcPs)
n) =
  let n' :: SrcSpanLess (Located RdrName)
n' = Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
n
   in if RdrName -> Bool
isRdrTyVar RdrName
SrcSpanLess (Located RdrName)
n'
        then Name -> Type
TH.VarT (RdrName -> Name
toName RdrName
SrcSpanLess (Located RdrName)
n')
        else Name -> Type
TH.ConT (RdrName -> Name
toName RdrName
SrcSpanLess (Located RdrName)
n')
toType HsType GhcPs
t = String -> String -> Type
forall e a. Show e => String -> e -> a
todo String
"toType" (DynFlags -> SDoc -> String
showSDocDebug ([Extension] -> DynFlags
baseDynFlags []) (SDoc -> String)
-> (HsType GhcPs -> SDoc) -> HsType GhcPs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HsType GhcPs -> String) -> HsType GhcPs -> String
forall a b. (a -> b) -> a -> b
$ HsType GhcPs
t)

toName :: RdrName -> TH.Name
toName :: RdrName -> Name
toName RdrName
n = case RdrName
n of
  (Unqual OccName
o) -> String -> Name
TH.mkName (OccName -> String
occNameString OccName
o)
  (Qual ModuleName
m OccName
o) -> String -> Name
TH.mkName (ModuleName -> String
Module.moduleNameString ModuleName
m String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OccName -> String
occNameString OccName
o)
  (Orig Module
m OccName
o) -> String -> Name
forall a. HasCallStack => String -> a
error String
"orig"
  (Exact Name
n1) -> String -> Name
forall a. HasCallStack => String -> a
error String
"exact"

toFieldExp :: a
toFieldExp :: a
toFieldExp = a
forall a. HasCallStack => a
undefined

toPat :: DynFlags -> Pat.Pat GhcPs -> TH.Pat
toPat :: DynFlags -> Pat GhcPs -> Pat
toPat DynFlags
_dynFlags (Pat.VarPat XVarPat GhcPs
_ (Located (IdP GhcPs) -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> SrcSpanLess (Located RdrName)
name)) = Name -> Pat
TH.VarP (RdrName -> Name
toName RdrName
SrcSpanLess (Located RdrName)
name)
toPat DynFlags
dynFlags Pat GhcPs
p = String -> String -> Pat
forall e a. Show e => String -> e -> a
todo String
"toPat" (DynFlags -> SDoc -> String
showSDocDebug DynFlags
dynFlags (SDoc -> String) -> (Pat GhcPs -> SDoc) -> Pat GhcPs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Pat GhcPs -> String) -> Pat GhcPs -> String
forall a b. (a -> b) -> a -> b
$ Pat GhcPs
p)

toExp :: DynFlags -> Expr.HsExpr GhcPs -> TH.Exp
toExp :: DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
_ (Expr.HsVar XVar GhcPs
_ Located (IdP GhcPs)
n) =
  let n' :: SrcSpanLess (Located RdrName)
n' = Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
n
   in if RdrName -> Bool
isRdrDataCon RdrName
SrcSpanLess (Located RdrName)
n'
        then Name -> Exp
TH.ConE (RdrName -> Name
toName RdrName
SrcSpanLess (Located RdrName)
n')
        else Name -> Exp
TH.VarE (RdrName -> Name
toName RdrName
SrcSpanLess (Located RdrName)
n')
#if MIN_VERSION_ghc(9,0,0)
toExp _ (Expr.HsUnboundVar _ n)              = TH.UnboundVarE (TH.mkName . occNameString $ n)
#else
toExp DynFlags
_ (Expr.HsUnboundVar XUnboundVar GhcPs
_ UnboundVar
n)              = Name -> Exp
TH.UnboundVarE (String -> Name
TH.mkName (String -> Name) -> (UnboundVar -> String) -> UnboundVar -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString (OccName -> String)
-> (UnboundVar -> OccName) -> UnboundVar -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnboundVar -> OccName
Expr.unboundVarOcc (UnboundVar -> Name) -> UnboundVar -> Name
forall a b. (a -> b) -> a -> b
$ UnboundVar
n)
#endif
toExp DynFlags
_ Expr.HsIPVar {} = String -> String -> Exp
forall e a. Show e => String -> e -> a
noTH String
"toExp" String
"HsIPVar"
toExp DynFlags
_ (Expr.HsLit XLitE GhcPs
_ HsLit GhcPs
l) = Lit -> Exp
TH.LitE (HsLit GhcPs -> Lit
toLit HsLit GhcPs
l)
toExp DynFlags
_ (Expr.HsOverLit XOverLitE GhcPs
_ OverLit {OverLitVal
ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val :: OverLitVal
ol_val}) = Lit -> Exp
TH.LitE (OverLitVal -> Lit
toLit' OverLitVal
ol_val)
toExp DynFlags
d (Expr.HsApp XApp GhcPs
_ LHsExpr GhcPs
e1 LHsExpr GhcPs
e2) = Exp -> Exp -> Exp
TH.AppE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsExpr GhcPs -> Exp) -> LHsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
e1) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsExpr GhcPs -> Exp) -> LHsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
e2)
#if MIN_VERSION_ghc(8,8,0)
toExp DynFlags
d (Expr.HsAppType XAppTypeE GhcPs
_ LHsExpr GhcPs
e HsWC {LHsType (NoGhcTc GhcPs)
hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body :: LHsType (NoGhcTc GhcPs)
hswc_body}) = Exp -> Type -> Exp
TH.AppTypeE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsExpr GhcPs -> Exp) -> LHsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
e) (HsType GhcPs -> Type
toType (HsType GhcPs -> Type)
-> (LHsType GhcPs -> HsType GhcPs) -> LHsType GhcPs -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType GhcPs -> HsType GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsType GhcPs -> Type) -> LHsType GhcPs -> Type
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs
LHsType (NoGhcTc GhcPs)
hswc_body)
#else
toExp d (Expr.HsAppType HsWC {hswc_body} e) = TH.AppTypeE (toExp d . unLoc $ e) (toType . unLoc $ hswc_body)
#endif
toExp DynFlags
d (Expr.OpApp XOpApp GhcPs
_ LHsExpr GhcPs
e1 LHsExpr GhcPs
o LHsExpr GhcPs
e2) = Exp -> Exp -> Exp -> Exp
TH.UInfixE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsExpr GhcPs -> Exp) -> LHsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
e1) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsExpr GhcPs -> Exp) -> LHsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
o) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsExpr GhcPs -> Exp) -> LHsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
e2)
toExp DynFlags
d (Expr.NegApp XNegApp GhcPs
_ LHsExpr GhcPs
e SyntaxExpr GhcPs
_) = Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE 'negate) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsExpr GhcPs -> Exp) -> LHsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
e)
-- NOTE: for lambda, there is only one match
toExp DynFlags
d (Expr.HsLam XLam GhcPs
_ (Expr.MG XMG GhcPs (LHsExpr GhcPs)
_ (Located [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> ((LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs))
-> [LMatch GhcPs (LHsExpr GhcPs)] -> [Match GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> [Expr.Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
_ ((Located (Pat GhcPs) -> Pat GhcPs)
-> [Located (Pat GhcPs)] -> [Pat GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat GhcPs) -> Pat GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> [Pat GhcPs]
ps) (Expr.GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [LGRHS GhcPs (LHsExpr GhcPs)
-> SrcSpanLess (LGRHS GhcPs (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> Expr.GRHS _ _ (unLoc -> e)] LHsLocalBinds GhcPs
_)])) Origin
_)) = [Pat] -> Exp -> Exp
TH.LamE ((Pat GhcPs -> Pat) -> [Pat GhcPs] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynFlags -> Pat GhcPs -> Pat
toPat DynFlags
d) [Pat GhcPs]
ps) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d HsExpr GhcPs
SrcSpanLess (LHsExpr GhcPs)
e)
-- toExp (Expr.Let _ bs e)                       = TH.LetE (toDecs bs) (toExp e)
-- toExp (Expr.If _ a b c)                       = TH.CondE (toExp a) (toExp b) (toExp c)
-- toExp (Expr.MultiIf _ ifs)                    = TH.MultiIfE (map toGuard ifs)
-- toExp (Expr.Case _ e alts)                    = TH.CaseE (toExp e) (map toMatch alts)
-- toExp (Expr.Do _ ss)                          = TH.DoE (map toStmt ss)
-- toExp e@Expr.MDo{}                            = noTH "toExp" e
#if MIN_VERSION_ghc(9, 2, 0)
toExp d (Expr.ExplicitTuple _ args boxity) = ctor tupArgs
#else
toExp DynFlags
d (Expr.ExplicitTuple XExplicitTuple GhcPs
_ ((LHsTupArg GhcPs -> HsTupArg GhcPs)
-> [LHsTupArg GhcPs] -> [HsTupArg GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LHsTupArg GhcPs -> HsTupArg GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> [HsTupArg GhcPs]
args) Boxity
boxity) = [Maybe Exp] -> Exp
ctor [Maybe Exp]
tupArgs
#endif
  where
    toTupArg :: HsTupArg id -> Maybe (HsExpr id)
toTupArg (Expr.Present XPresent id
_ LHsExpr id
e) = HsExpr id -> Maybe (HsExpr id)
forall a. a -> Maybe a
Just (HsExpr id -> Maybe (HsExpr id)) -> HsExpr id -> Maybe (HsExpr id)
forall a b. (a -> b) -> a -> b
$ LHsExpr id -> SrcSpanLess (LHsExpr id)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr id
e
    toTupArg (Expr.Missing XMissing id
_) = Maybe (HsExpr id)
forall a. Maybe a
Nothing
    toTupArg HsTupArg id
_ = String -> Maybe (HsExpr id)
forall a. HasCallStack => String -> a
error String
"impossible case"

    ctor :: [Maybe Exp] -> Exp
ctor = case Boxity
boxity of
      Boxity
Boxed -> [Maybe Exp] -> Exp
TH.TupE
      Boxity
Unboxed -> [Maybe Exp] -> Exp
TH.UnboxedTupE

#if MIN_VERSION_ghc(8,10,0)
    tupArgs :: [Maybe Exp]
tupArgs = (HsTupArg GhcPs -> Maybe Exp) -> [HsTupArg GhcPs] -> [Maybe Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((HsExpr GhcPs -> Exp) -> Maybe (HsExpr GhcPs) -> Maybe Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d)) (Maybe (HsExpr GhcPs) -> Maybe Exp)
-> (HsTupArg GhcPs -> Maybe (HsExpr GhcPs))
-> HsTupArg GhcPs
-> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTupArg GhcPs -> Maybe (HsExpr GhcPs)
forall id. HsTupArg id -> Maybe (HsExpr id)
toTupArg) [HsTupArg GhcPs]
args
#else
    tupArgs = case traverse toTupArg args of
      Nothing -> error "Tuple section are not supported by template haskell < 8.10"
      Just args -> fmap (toExp d) args
#endif

-- toExp (Expr.List _ xs)                        = TH.ListE (fmap toExp xs)
toExp DynFlags
d (Expr.HsPar XPar GhcPs
_ LHsExpr GhcPs
e) = Exp -> Exp
TH.ParensE (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp)
-> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsExpr GhcPs -> Exp) -> LHsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
e)
toExp DynFlags
d (Expr.SectionL XSectionL GhcPs
_ (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> SrcSpanLess (LHsExpr GhcPs)
a) (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> SrcSpanLess (LHsExpr GhcPs)
b)) = Maybe Exp -> Exp -> Maybe Exp -> Exp
TH.InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp)
-> (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Maybe Exp) -> HsExpr GhcPs -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs
SrcSpanLess (LHsExpr GhcPs)
a) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d HsExpr GhcPs
SrcSpanLess (LHsExpr GhcPs)
b) Maybe Exp
forall a. Maybe a
Nothing
toExp DynFlags
d (Expr.SectionR XSectionR GhcPs
_ (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> SrcSpanLess (LHsExpr GhcPs)
a) (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> SrcSpanLess (LHsExpr GhcPs)
b)) = Maybe Exp -> Exp -> Maybe Exp -> Exp
TH.InfixE Maybe Exp
forall a. Maybe a
Nothing (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d HsExpr GhcPs
SrcSpanLess (LHsExpr GhcPs)
a) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp)
-> (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Maybe Exp) -> HsExpr GhcPs -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs
SrcSpanLess (LHsExpr GhcPs)
b)
toExp DynFlags
_ (Expr.RecordCon XRecordCon GhcPs
_ Located (IdP GhcPs)
name HsRecFields {[LHsRecField GhcPs (LHsExpr GhcPs)]
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds :: [LHsRecField GhcPs (LHsExpr GhcPs)]
rec_flds}) =
  Name -> [FieldExp] -> Exp
TH.RecConE (RdrName -> Name
toName (RdrName -> Name)
-> (Located RdrName -> RdrName) -> Located RdrName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located RdrName -> Name) -> Located RdrName -> Name
forall a b. (a -> b) -> a -> b
$ Located (IdP GhcPs)
Located RdrName
name) ((LHsRecField GhcPs (LHsExpr GhcPs) -> FieldExp)
-> [LHsRecField GhcPs (LHsExpr GhcPs)] -> [FieldExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsRecField GhcPs (LHsExpr GhcPs) -> FieldExp
forall a. a
toFieldExp [LHsRecField GhcPs (LHsExpr GhcPs)]
rec_flds)
-- toExp (Expr.RecUpdate _ e xs)                 = TH.RecUpdE (toExp e) (fmap toFieldExp xs)
-- toExp (Expr.ListComp _ e ss)                  = TH.CompE $ map convert ss ++ [TH.NoBindS (toExp e)]
--  where
--   convert (Expr.QualStmt _ st)                = toStmt st
--   convert s                                   = noTH "toExp ListComp" s
-- toExp (Expr.ExpTypeSig _ e t)                 = TH.SigE (toExp e) (toType t)
#if MIN_VERSION_ghc(9, 2, 0)
toExp d (Expr.ExplicitList _ (map unLoc -> args)) = TH.ListE (map (toExp d) args)
#else
toExp DynFlags
d (Expr.ExplicitList XExplicitList GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ ((LHsExpr GhcPs -> HsExpr GhcPs)
-> [LHsExpr GhcPs] -> [HsExpr GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LHsExpr GhcPs -> HsExpr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc -> [HsExpr GhcPs]
args)) = [Exp] -> Exp
TH.ListE ((HsExpr GhcPs -> Exp) -> [HsExpr GhcPs] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d) [HsExpr GhcPs]
args)
#endif
toExp DynFlags
d (Expr.ArithSeq XArithSeq GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
e) = Range -> Exp
TH.ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$ case ArithSeqInfo GhcPs
e of
  (From LHsExpr GhcPs
a) -> Exp -> Range
TH.FromR (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
a)
  (FromThen LHsExpr GhcPs
a LHsExpr GhcPs
b) -> Exp -> Exp -> Range
TH.FromThenR (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
a) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
b)
  (FromTo LHsExpr GhcPs
a LHsExpr GhcPs
b) -> Exp -> Exp -> Range
TH.FromToR (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
a) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
b)
  (FromThenTo LHsExpr GhcPs
a LHsExpr GhcPs
b LHsExpr GhcPs
c) -> Exp -> Exp -> Exp -> Range
TH.FromThenToR (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
a) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
b) (DynFlags -> HsExpr GhcPs -> Exp
toExp DynFlags
d (HsExpr GhcPs -> Exp) -> HsExpr GhcPs -> Exp
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
c)
toExp DynFlags
dynFlags HsExpr GhcPs
e = String -> String -> Exp
forall e a. Show e => String -> e -> a
todo String
"toExp" (DynFlags -> SDoc -> String
showSDocDebug DynFlags
dynFlags (SDoc -> String)
-> (HsExpr GhcPs -> SDoc) -> HsExpr GhcPs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HsExpr GhcPs -> String) -> HsExpr GhcPs -> String
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs
e)

todo :: (Show e) => String -> e -> a
todo :: String -> e -> a
todo String
fun e
thing = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ([String] -> String) -> [String] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> a) -> [String] -> a
forall a b. (a -> b) -> a -> b
$ [String
moduleName, String
".", String
fun, String
": not implemented: ", e -> String
forall a. Show a => a -> String
show e
thing]

noTH :: (Show e) => String -> e -> a
noTH :: String -> e -> a
noTH String
fun e
thing = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> ([String] -> String) -> [String] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> a) -> [String] -> a
forall a b. (a -> b) -> a -> b
$ [String
moduleName, String
".", String
fun, String
": no TemplateHaskell for: ", e -> String
forall a. Show a => a -> String
show e
thing]

moduleName :: String
moduleName :: String
moduleName = String
"PyF.Internal.Meta"

baseDynFlags :: [GhcTH.Extension] -> DynFlags
baseDynFlags :: [Extension] -> DynFlags
baseDynFlags [Extension]
exts =
  let enable :: [Extension]
enable = Extension
GhcTH.TemplateHaskellQuotes Extension -> [Extension] -> [Extension]
forall a. a -> [a] -> [a]
: [Extension]
exts
   in (DynFlags -> Extension -> DynFlags)
-> DynFlags -> [Extension] -> DynFlags
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> Extension -> DynFlags
xopt_set (Settings -> LlvmConfig -> DynFlags
defaultDynFlags Settings
fakeSettings LlvmConfig
fakeLlvmConfig) [Extension]
enable

translateTHtoGHCExt :: TH.Extension -> GhcTH.Extension
translateTHtoGHCExt :: Extension -> Extension
translateTHtoGHCExt Extension
TH.Cpp = Extension
GhcTH.Cpp
translateTHtoGHCExt Extension
TH.OverlappingInstances = Extension
GhcTH.OverlappingInstances
translateTHtoGHCExt Extension
TH.UndecidableInstances = Extension
GhcTH.UndecidableInstances
translateTHtoGHCExt Extension
TH.IncoherentInstances = Extension
GhcTH.IncoherentInstances
translateTHtoGHCExt Extension
TH.UndecidableSuperClasses = Extension
GhcTH.UndecidableSuperClasses
translateTHtoGHCExt Extension
TH.MonomorphismRestriction = Extension
GhcTH.MonomorphismRestriction
#if ! MIN_VERSION_ghc(9,2,0)
translateTHtoGHCExt Extension
TH.MonoPatBinds = Extension
GhcTH.MonoPatBinds
#endif
translateTHtoGHCExt Extension
TH.MonoLocalBinds = Extension
GhcTH.MonoLocalBinds
translateTHtoGHCExt Extension
TH.RelaxedPolyRec = Extension
GhcTH.RelaxedPolyRec
translateTHtoGHCExt Extension
TH.ExtendedDefaultRules = Extension
GhcTH.ExtendedDefaultRules
translateTHtoGHCExt Extension
TH.ForeignFunctionInterface = Extension
GhcTH.ForeignFunctionInterface
translateTHtoGHCExt Extension
TH.UnliftedFFITypes = Extension
GhcTH.UnliftedFFITypes
translateTHtoGHCExt Extension
TH.InterruptibleFFI = Extension
GhcTH.InterruptibleFFI
translateTHtoGHCExt Extension
TH.CApiFFI = Extension
GhcTH.CApiFFI
translateTHtoGHCExt Extension
TH.GHCForeignImportPrim = Extension
GhcTH.GHCForeignImportPrim
translateTHtoGHCExt Extension
TH.JavaScriptFFI = Extension
GhcTH.JavaScriptFFI
translateTHtoGHCExt Extension
TH.ParallelArrays = Extension
GhcTH.ParallelArrays
translateTHtoGHCExt Extension
TH.Arrows = Extension
GhcTH.Arrows
translateTHtoGHCExt Extension
TH.TemplateHaskell = Extension
GhcTH.TemplateHaskell
translateTHtoGHCExt Extension
TH.TemplateHaskellQuotes = Extension
GhcTH.TemplateHaskellQuotes
translateTHtoGHCExt Extension
TH.QuasiQuotes = Extension
GhcTH.QuasiQuotes
translateTHtoGHCExt Extension
TH.ImplicitParams = Extension
GhcTH.ImplicitParams
translateTHtoGHCExt Extension
TH.ImplicitPrelude = Extension
GhcTH.ImplicitPrelude
translateTHtoGHCExt Extension
TH.ScopedTypeVariables = Extension
GhcTH.ScopedTypeVariables
translateTHtoGHCExt Extension
TH.AllowAmbiguousTypes = Extension
GhcTH.AllowAmbiguousTypes
translateTHtoGHCExt Extension
TH.UnboxedTuples = Extension
GhcTH.UnboxedTuples
translateTHtoGHCExt Extension
TH.UnboxedSums = Extension
GhcTH.UnboxedSums
translateTHtoGHCExt Extension
TH.BangPatterns = Extension
GhcTH.BangPatterns
translateTHtoGHCExt Extension
TH.TypeFamilies = Extension
GhcTH.TypeFamilies
translateTHtoGHCExt Extension
TH.TypeFamilyDependencies = Extension
GhcTH.TypeFamilyDependencies
translateTHtoGHCExt Extension
TH.TypeInType = Extension
GhcTH.TypeInType
translateTHtoGHCExt Extension
TH.OverloadedStrings = Extension
GhcTH.OverloadedStrings
translateTHtoGHCExt Extension
TH.OverloadedLists = Extension
GhcTH.OverloadedLists
translateTHtoGHCExt Extension
TH.NumDecimals = Extension
GhcTH.NumDecimals
translateTHtoGHCExt Extension
TH.DisambiguateRecordFields = Extension
GhcTH.DisambiguateRecordFields
translateTHtoGHCExt Extension
TH.RecordWildCards = Extension
GhcTH.RecordWildCards
translateTHtoGHCExt Extension
TH.RecordPuns = Extension
GhcTH.RecordPuns
translateTHtoGHCExt Extension
TH.ViewPatterns = Extension
GhcTH.ViewPatterns
translateTHtoGHCExt Extension
TH.GADTs = Extension
GhcTH.GADTs
translateTHtoGHCExt Extension
TH.GADTSyntax = Extension
GhcTH.GADTSyntax
translateTHtoGHCExt Extension
TH.NPlusKPatterns = Extension
GhcTH.NPlusKPatterns
translateTHtoGHCExt Extension
TH.DoAndIfThenElse = Extension
GhcTH.DoAndIfThenElse
translateTHtoGHCExt Extension
TH.BlockArguments = Extension
GhcTH.BlockArguments
translateTHtoGHCExt Extension
TH.RebindableSyntax = Extension
GhcTH.RebindableSyntax
translateTHtoGHCExt Extension
TH.ConstraintKinds = Extension
GhcTH.ConstraintKinds
translateTHtoGHCExt Extension
TH.PolyKinds = Extension
GhcTH.PolyKinds
translateTHtoGHCExt Extension
TH.DataKinds = Extension
GhcTH.DataKinds
translateTHtoGHCExt Extension
TH.InstanceSigs = Extension
GhcTH.InstanceSigs
translateTHtoGHCExt Extension
TH.ApplicativeDo = Extension
GhcTH.ApplicativeDo
translateTHtoGHCExt Extension
TH.StandaloneDeriving = Extension
GhcTH.StandaloneDeriving
translateTHtoGHCExt Extension
TH.DeriveDataTypeable = Extension
GhcTH.DeriveDataTypeable
translateTHtoGHCExt Extension
TH.AutoDeriveTypeable = Extension
GhcTH.AutoDeriveTypeable
translateTHtoGHCExt Extension
TH.DeriveFunctor = Extension
GhcTH.DeriveFunctor
translateTHtoGHCExt Extension
TH.DeriveTraversable = Extension
GhcTH.DeriveTraversable
translateTHtoGHCExt Extension
TH.DeriveFoldable = Extension
GhcTH.DeriveFoldable
translateTHtoGHCExt Extension
TH.DeriveGeneric = Extension
GhcTH.DeriveGeneric
translateTHtoGHCExt Extension
TH.DefaultSignatures = Extension
GhcTH.DefaultSignatures
translateTHtoGHCExt Extension
TH.DeriveAnyClass = Extension
GhcTH.DeriveAnyClass
translateTHtoGHCExt Extension
TH.DeriveLift = Extension
GhcTH.DeriveLift
translateTHtoGHCExt Extension
TH.DerivingStrategies = Extension
GhcTH.DerivingStrategies
translateTHtoGHCExt Extension
TH.DerivingVia = Extension
GhcTH.DerivingVia
translateTHtoGHCExt Extension
TH.TypeSynonymInstances = Extension
GhcTH.TypeSynonymInstances
translateTHtoGHCExt Extension
TH.FlexibleContexts = Extension
GhcTH.FlexibleContexts
translateTHtoGHCExt Extension
TH.FlexibleInstances = Extension
GhcTH.FlexibleInstances
translateTHtoGHCExt Extension
TH.ConstrainedClassMethods = Extension
GhcTH.ConstrainedClassMethods
translateTHtoGHCExt Extension
TH.MultiParamTypeClasses = Extension
GhcTH.MultiParamTypeClasses
translateTHtoGHCExt Extension
TH.NullaryTypeClasses = Extension
GhcTH.NullaryTypeClasses
translateTHtoGHCExt Extension
TH.FunctionalDependencies = Extension
GhcTH.FunctionalDependencies
translateTHtoGHCExt Extension
TH.UnicodeSyntax = Extension
GhcTH.UnicodeSyntax
translateTHtoGHCExt Extension
TH.ExistentialQuantification = Extension
GhcTH.ExistentialQuantification
translateTHtoGHCExt Extension
TH.MagicHash = Extension
GhcTH.MagicHash
translateTHtoGHCExt Extension
TH.EmptyDataDecls = Extension
GhcTH.EmptyDataDecls
translateTHtoGHCExt Extension
TH.KindSignatures = Extension
GhcTH.KindSignatures
translateTHtoGHCExt Extension
TH.RoleAnnotations = Extension
GhcTH.RoleAnnotations
translateTHtoGHCExt Extension
TH.ParallelListComp = Extension
GhcTH.ParallelListComp
translateTHtoGHCExt Extension
TH.TransformListComp = Extension
GhcTH.TransformListComp
translateTHtoGHCExt Extension
TH.MonadComprehensions = Extension
GhcTH.MonadComprehensions
translateTHtoGHCExt Extension
TH.GeneralizedNewtypeDeriving = Extension
GhcTH.GeneralizedNewtypeDeriving
translateTHtoGHCExt Extension
TH.RecursiveDo = Extension
GhcTH.RecursiveDo
translateTHtoGHCExt Extension
TH.PostfixOperators = Extension
GhcTH.PostfixOperators
translateTHtoGHCExt Extension
TH.TupleSections = Extension
GhcTH.TupleSections
translateTHtoGHCExt Extension
TH.PatternGuards = Extension
GhcTH.PatternGuards
translateTHtoGHCExt Extension
TH.LiberalTypeSynonyms = Extension
GhcTH.LiberalTypeSynonyms
translateTHtoGHCExt Extension
TH.RankNTypes = Extension
GhcTH.RankNTypes
translateTHtoGHCExt Extension
TH.ImpredicativeTypes = Extension
GhcTH.ImpredicativeTypes
translateTHtoGHCExt Extension
TH.TypeOperators = Extension
GhcTH.TypeOperators
translateTHtoGHCExt Extension
TH.ExplicitNamespaces = Extension
GhcTH.ExplicitNamespaces
translateTHtoGHCExt Extension
TH.PackageImports = Extension
GhcTH.PackageImports
translateTHtoGHCExt Extension
TH.ExplicitForAll = Extension
GhcTH.ExplicitForAll
translateTHtoGHCExt Extension
TH.AlternativeLayoutRule = Extension
GhcTH.AlternativeLayoutRule
translateTHtoGHCExt Extension
TH.AlternativeLayoutRuleTransitional = Extension
GhcTH.AlternativeLayoutRuleTransitional
translateTHtoGHCExt Extension
TH.DatatypeContexts = Extension
GhcTH.DatatypeContexts
translateTHtoGHCExt Extension
TH.NondecreasingIndentation = Extension
GhcTH.NondecreasingIndentation
translateTHtoGHCExt Extension
TH.RelaxedLayout = Extension
GhcTH.RelaxedLayout
translateTHtoGHCExt Extension
TH.TraditionalRecordSyntax = Extension
GhcTH.TraditionalRecordSyntax
translateTHtoGHCExt Extension
TH.LambdaCase = Extension
GhcTH.LambdaCase
translateTHtoGHCExt Extension
TH.MultiWayIf = Extension
GhcTH.MultiWayIf
translateTHtoGHCExt Extension
TH.BinaryLiterals = Extension
GhcTH.BinaryLiterals
translateTHtoGHCExt Extension
TH.NegativeLiterals = Extension
GhcTH.NegativeLiterals
translateTHtoGHCExt Extension
TH.HexFloatLiterals = Extension
GhcTH.HexFloatLiterals
translateTHtoGHCExt Extension
TH.DuplicateRecordFields = Extension
GhcTH.DuplicateRecordFields
translateTHtoGHCExt Extension
TH.OverloadedLabels = Extension
GhcTH.OverloadedLabels
translateTHtoGHCExt Extension
TH.EmptyCase = Extension
GhcTH.EmptyCase
translateTHtoGHCExt Extension
TH.PatternSynonyms = Extension
GhcTH.PatternSynonyms
translateTHtoGHCExt Extension
TH.PartialTypeSignatures = Extension
GhcTH.PartialTypeSignatures
translateTHtoGHCExt Extension
TH.NamedWildCards = Extension
GhcTH.NamedWildCards
translateTHtoGHCExt Extension
TH.StaticPointers = Extension
GhcTH.StaticPointers
translateTHtoGHCExt Extension
TH.TypeApplications = Extension
GhcTH.TypeApplications
translateTHtoGHCExt Extension
TH.Strict = Extension
GhcTH.Strict
translateTHtoGHCExt Extension
TH.StrictData = Extension
GhcTH.StrictData
#if ! MIN_VERSION_ghc(9,2,0)
translateTHtoGHCExt Extension
TH.MonadFailDesugaring = Extension
GhcTH.MonadFailDesugaring
#endif
translateTHtoGHCExt Extension
TH.EmptyDataDeriving = Extension
GhcTH.EmptyDataDeriving
translateTHtoGHCExt Extension
TH.NumericUnderscores = Extension
GhcTH.NumericUnderscores
translateTHtoGHCExt Extension
TH.QuantifiedConstraints = Extension
GhcTH.QuantifiedConstraints
translateTHtoGHCExt Extension
TH.StarIsType = Extension
GhcTH.StarIsType

#if MIN_VERSION_ghc(8,10,0)
translateTHtoGHCExt Extension
TH.CUSKs = Extension
GhcTH.CUSKs
translateTHtoGHCExt Extension
TH.ImportQualifiedPost = Extension
GhcTH.ImportQualifiedPost
translateTHtoGHCExt Extension
TH.UnliftedNewtypes = Extension
GhcTH.UnliftedNewtypes
translateTHtoGHCExt Extension
TH.StandaloneKindSignatures = Extension
GhcTH.StandaloneKindSignatures
#endif
#if MIN_VERSION_ghc(9,0,0)
translateTHtoGHCExt TH.QualifiedDo = GhcTH.QualifiedDo
translateTHtoGHCExt TH.LinearTypes = GhcTH.LinearTypes
translateTHtoGHCExt TH.LexicalNegation = GhcTH.LexicalNegation
#endif
#if MIN_VERSION_ghc(9,2,0)
translateTHtoGHCExt TH.UnliftedDatatypes = GhcTH.UnliftedDatatypes
translateTHtoGHCExt TH.FieldSelectors = GhcTH.FieldSelectors
translateTHtoGHCExt TH.OverloadedRecordDot = GhcTH.OverloadedRecordDot
translateTHtoGHCExt TH.OverloadedRecordUpdate = GhcTH.OverloadedRecordUpdate
#endif