{-# LANGUAGE CPP #-}
module GHC.SourceGen.Overloaded
( Par(..)
, App(..)
, HasTuple(..)
, tuple
, unboxedTuple
, HasList(..)
, Var(..)
, BVar(..)
) where
import GHC.Hs.Type
( HsType(..)
, HsTyVarBndr(..)
)
import GHC.Hs (IE(..), IEWrappedName(..)
#if MIN_VERSION_ghc(9,6,0)
, noExtField
#endif
)
#if !MIN_VERSION_ghc(8,6,0)
import PlaceHolder(PlaceHolder(..))
#endif
import GHC.Hs
( HsExpr(..)
, Pat(..)
, HsTupArg(..)
, HsTupleSort(..)
)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (Boxity(..))
import GHC.Core.DataCon (dataConName)
import GHC.Types.Name.Reader (nameRdrName)
import GHC.Builtin.Types (consDataCon_RDR, nilDataCon, unitDataCon)
import GHC.Types.Var (Specificity(..))
#else
import BasicTypes (Boxity(..))
import DataCon (dataConName)
import RdrName (nameRdrName)
import TysWiredIn (consDataCon_RDR, nilDataCon, unitDataCon)
#endif
import GHC.SourceGen.Expr.Internal
import GHC.SourceGen.Name.Internal
import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Type.Internal
class Par e where
par :: e -> e
instance Par HsExpr' where
#if MIN_VERSION_ghc(9,4,0)
par p = withEpAnnNotUsed HsPar mkToken (mkLocated p) mkToken
#else
par :: HsExpr' -> HsExpr'
par = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated
#endif
instance Par Pat' where
#if MIN_VERSION_ghc(9,4,0)
par p = withEpAnnNotUsed ParPat mkToken (builtPat p) mkToken
#else
par :: Pat' -> Pat'
par = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XParPat p -> LPat p -> Pat p
ParPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat' -> LPat'
builtPat
#endif
instance Par HsType' where
par :: HsType' -> HsType'
par = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated
class App e where
(@@) :: e -> e -> e
op :: e -> RdrNameStr -> e -> e
infixl 2 @@
instance App HsExpr' where
op :: HsExpr' -> RdrNameStr -> HsExpr' -> HsExpr'
op HsExpr'
x RdrNameStr
o HsExpr'
y
= forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp
(LHsExpr' -> LHsExpr'
parenthesizeExprForOp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
x)
(forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated forall a b. (a -> b) -> a -> b
$ forall a. Var a => RdrNameStr -> a
var RdrNameStr
o)
#if !MIN_VERSION_ghc(8,6,0)
PlaceHolder
#endif
(LHsExpr' -> LHsExpr'
parenthesizeExprForOp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
y)
HsExpr'
x @@ :: HsExpr' -> HsExpr' -> HsExpr'
@@ HsExpr'
y = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp (LHsExpr' -> LHsExpr'
parenthesizeExprForOp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
x)
(LHsExpr' -> LHsExpr'
parenthesizeExprForApp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
y)
instance App HsType' where
op :: HsType' -> RdrNameStr -> HsType' -> HsType'
op HsType'
x RdrNameStr
o HsType'
y
#if MIN_VERSION_ghc(9,4,0)
= withEpAnnNotUsed HsOpTy notPromoted (parenthesizeTypeForOp $ mkLocated x)
(typeRdrName o)
(parenthesizeTypeForOp $ mkLocated y)
#else
= forall a. (NoExtField -> a) -> a
noExt forall pass.
XOpTy pass
-> LHsType pass -> LIdP pass -> LHsType pass -> HsType pass
HsOpTy (LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForOp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
x)
(RdrNameStr -> LocatedN RdrName
typeRdrName RdrNameStr
o)
(LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForOp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
y)
#endif
HsType'
x @@ :: HsType' -> HsType' -> HsType'
@@ HsType'
y = forall a. (NoExtField -> a) -> a
noExt forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy
(LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForOp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
x)
(LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForApp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
y)
class HasTuple e where
unit :: e
tupleOf :: Boxity -> [e] -> e
tuple, unboxedTuple :: HasTuple e => [e] -> e
tuple :: forall e. HasTuple e => [e] -> e
tuple = forall e. HasTuple e => Boxity -> [e] -> e
tupleOf Boxity
Boxed
unboxedTuple :: forall e. HasTuple e => [e] -> e
unboxedTuple = forall e. HasTuple e => Boxity -> [e] -> e
tupleOf Boxity
Unboxed
instance HasTuple HsExpr' where
tupleOf :: Boxity -> [HsExpr'] -> HsExpr'
tupleOf Boxity
b [HsExpr']
ts =
[HsTupArg GhcPs] -> Boxity -> HsExpr'
explicitTuple
(forall a b. (a -> b) -> [a] -> [b]
map (forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated) [HsExpr']
ts)
Boxity
b
where
#if MIN_VERSION_ghc(9,2,0)
explicitTuple :: [HsTupArg GhcPs] -> Boxity -> HsExpr'
explicitTuple = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple
#else
explicitTuple = noExt ExplicitTuple . map builtLoc
#endif
unit :: HsExpr'
unit = forall a. (NoExtField -> a) -> a
noExt forall p. XVar p -> LIdP p -> HsExpr p
HsVar LIdP
unitDataConName
unitDataConName :: LIdP
unitDataConName :: LIdP
unitDataConName = forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated forall a b. (a -> b) -> a -> b
$ Name -> RdrName
nameRdrName forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName forall a b. (a -> b) -> a -> b
$ DataCon
unitDataCon
instance HasTuple HsType' where
tupleOf :: Boxity -> [HsType'] -> HsType'
tupleOf Boxity
b = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy HsTupleSort
b' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated
where
b' :: HsTupleSort
b' = case Boxity
b of
Boxity
Unboxed -> HsTupleSort
HsUnboxedTuple
Boxity
Boxed -> HsTupleSort
HsBoxedOrConstraintTuple
unit :: HsType'
unit = forall e. HasTuple e => Boxity -> [e] -> e
tupleOf Boxity
Boxed []
instance HasTuple Pat' where
tupleOf :: Boxity -> [Pat'] -> Pat'
tupleOf Boxity
b [Pat']
ps =
forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat (forall a b. (a -> b) -> [a] -> [b]
map Pat' -> LPat'
builtPat [Pat']
ps) Boxity
b
#if !MIN_VERSION_ghc(8,6,0)
[]
#endif
unit :: Pat'
unit = forall a. (NoExtField -> a) -> a
noExt forall p. XVarPat p -> LIdP p -> Pat p
VarPat LIdP
unitDataConName
class HasList e where
list :: [e] -> e
nil :: e
cons :: e
nilDataConName :: LIdP
nilDataConName :: LIdP
nilDataConName = forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated forall a b. (a -> b) -> a -> b
$ Name -> RdrName
nameRdrName forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName forall a b. (a -> b) -> a -> b
$ DataCon
nilDataCon
instance HasList HsExpr' where
list :: [HsExpr'] -> HsExpr'
list = forall a. a -> a
withPlaceHolder (forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall {p}. XExplicitList p -> [XRec p (HsExpr p)] -> HsExpr p
explicitList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated
where
#if MIN_VERSION_ghc(9,2,0)
explicitList :: XExplicitList p -> [XRec p (HsExpr p)] -> HsExpr p
explicitList = forall {p}. XExplicitList p -> [XRec p (HsExpr p)] -> HsExpr p
ExplicitList
#else
explicitList x = ExplicitList x Nothing
#endif
nil :: HsExpr'
nil = forall a. (NoExtField -> a) -> a
noExt forall p. XVar p -> LIdP p -> HsExpr p
HsVar LIdP
nilDataConName
cons :: HsExpr'
cons = forall a. (NoExtField -> a) -> a
noExt forall p. XVar p -> LIdP p -> HsExpr p
HsVar forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated RdrName
consDataCon_RDR
instance HasList Pat' where
#if MIN_VERSION_ghc(8,6,0)
list :: [Pat'] -> Pat'
list = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XListPat p -> [LPat p] -> Pat p
ListPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Pat' -> LPat'
builtPat
#else
list ps = ListPat (map builtPat ps) PlaceHolder Nothing
#endif
nil :: Pat'
nil = forall a. (NoExtField -> a) -> a
noExt forall p. XVarPat p -> LIdP p -> Pat p
VarPat LIdP
nilDataConName
cons :: Pat'
cons = forall a. (NoExtField -> a) -> a
noExt forall p. XVarPat p -> LIdP p -> Pat p
VarPat forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated forall a b. (a -> b) -> a -> b
$ RdrName
consDataCon_RDR
class BVar a where
bvar :: OccNameStr -> a
class BVar a => Var a where
var :: RdrNameStr -> a
instance BVar Pat' where
bvar :: OccNameStr -> Pat'
bvar = forall a. (NoExtField -> a) -> a
noExt forall p. XVarPat p -> LIdP p -> Pat p
VarPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LocatedN RdrName
valueRdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr
instance Var HsExpr' where
var :: RdrNameStr -> HsExpr'
var = forall a. (NoExtField -> a) -> a
noExt forall p. XVar p -> LIdP p -> HsExpr p
HsVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LocatedN RdrName
valueRdrName
instance BVar HsExpr' where
bvar :: OccNameStr -> HsExpr'
bvar = forall a. Var a => RdrNameStr -> a
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr
instance Var HsType' where
var :: RdrNameStr -> HsType'
var = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar PromotionFlag
notPromoted forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LocatedN RdrName
typeRdrName
instance BVar HsType' where
bvar :: OccNameStr -> HsType'
bvar = forall a. Var a => RdrNameStr -> a
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr
#if MIN_VERSION_ghc(9,0,0)
instance BVar HsTyVarBndr' where
bvar :: OccNameStr -> HsTyVarBndr'
bvar = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar () forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LocatedN RdrName
typeRdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr
instance BVar HsTyVarBndrS' where
bvar :: OccNameStr -> HsTyVarBndrS'
bvar = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar Specificity
SpecifiedSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrNameStr -> LocatedN RdrName
typeRdrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr
#else
instance BVar HsTyVarBndr' where
bvar = withEpAnnNotUsed UserTyVar . typeRdrName . UnqualStr
#endif
instance Var IE' where
var :: RdrNameStr -> IE'
var RdrNameStr
n =
forall a. (NoExtField -> a) -> a
noExt forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_ghc(9,6,0)
(IEName noExtField)
#else
forall name. LocatedN name -> IEWrappedName name
IEName
#endif
forall a b. (a -> b) -> a -> b
$ RdrNameStr -> LocatedN RdrName
exportRdrName RdrNameStr
n
instance BVar IE' where
bvar :: OccNameStr -> IE'
bvar = forall a. Var a => RdrNameStr -> a
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
UnqualStr