{-# LANGUAGE CPP #-}
module GHC.SourceGen.Binds
(
HsBind'
, HasValBind
, typeSig
, typeSigs
, funBind
, funBinds
, funBindsWithFixity
, valBind
, valBindGRHSs
, HasPatBind
, patBind
, patBindGRHSs
, RawMatch
, match
, matchGRHSs
, RawGRHSs
, rhs
, guardedRhs
, GuardedExpr
, GRHS'
, guards
, guard
, where'
, RawValBind
, stmt
, (<--)
) where
#if MIN_VERSION_ghc(9,0,0)
import GHC (LexicalFixity(..))
#else
import GHC.Types.Basic (LexicalFixity(..))
#endif
import Data.Bool (bool)
import Data.Maybe (fromMaybe)
import GHC.Hs.Binds
import GHC.Hs.Expr
import GHC.Hs.Type
import GHC.Plugins (isSymOcc)
#if !MIN_VERSION_ghc(9,0,1)
import GHC.Tc.Types.Evidence (HsWrapper(WpHole))
#endif
import GHC.SourceGen.Binds.Internal
import GHC.SourceGen.Name
import GHC.SourceGen.Name.Internal
import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Type.Internal (sigWcType)
typeSigs :: HasValBind t => [OccNameStr] -> HsType' -> t
typeSigs :: forall t. HasValBind t => [OccNameStr] -> HsType' -> t
typeSigs [OccNameStr]
names HsType'
t =
Sig' -> t
forall t. HasValBind t => Sig' -> t
sigB (Sig' -> t) -> Sig' -> t
forall a b. (a -> b) -> a -> b
$ (EpAnn AnnSig -> [LocatedN RdrName] -> LHsSigWcType' -> Sig')
-> [LocatedN RdrName] -> LHsSigWcType' -> Sig'
forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed XTypeSig GhcPs -> [LIdP GhcPs] -> LHsSigWcType' -> Sig'
EpAnn AnnSig -> [LocatedN RdrName] -> LHsSigWcType' -> Sig'
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig ((OccNameStr -> LocatedN RdrName)
-> [OccNameStr] -> [LocatedN RdrName]
forall a b. (a -> b) -> [a] -> [b]
map (RdrNameStr -> LocatedN RdrName
typeRdrName (RdrNameStr -> LocatedN RdrName)
-> (OccNameStr -> RdrNameStr) -> OccNameStr -> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccNameStr -> RdrNameStr
unqual) [OccNameStr]
names)
(LHsSigWcType' -> Sig') -> LHsSigWcType' -> Sig'
forall a b. (a -> b) -> a -> b
$ HsType' -> LHsSigWcType'
sigWcType HsType'
t
typeSig :: HasValBind t => OccNameStr -> HsType' -> t
typeSig :: forall t. HasValBind t => OccNameStr -> HsType' -> t
typeSig OccNameStr
n = [OccNameStr] -> HsType' -> t
forall t. HasValBind t => [OccNameStr] -> HsType' -> t
typeSigs [OccNameStr
n]
funBindsWithFixity :: HasValBind t => Maybe LexicalFixity -> OccNameStr -> [RawMatch] -> t
funBindsWithFixity :: forall t.
HasValBind t =>
Maybe LexicalFixity -> OccNameStr -> [RawMatch] -> t
funBindsWithFixity Maybe LexicalFixity
fixity OccNameStr
name [RawMatch]
matches = HsBind' -> t
forall t. HasValBind t => HsBind' -> t
bindB (HsBind' -> t) -> HsBind' -> t
forall a b. (a -> b) -> a -> b
$ HsBind' -> HsBind'
forall a. a -> a
withPlaceHolder
((NoExtField
-> LocatedN RdrName
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsBind')
-> LocatedN RdrName
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsBind'
forall a. (NoExtField -> a) -> a
noExt XFunBind GhcPs GhcPs
-> LIdP GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsBind'
NoExtField
-> LocatedN RdrName
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsBind'
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind LocatedN RdrName
name'
(HsMatchContext' -> [RawMatch] -> MatchGroup GhcPs (LHsExpr GhcPs)
matchGroup HsMatchContext'
context [RawMatch]
matches)
#if !MIN_VERSION_ghc(9,0,1)
WpHole
#endif
)
#if !MIN_VERSION_ghc(9,6,0)
[]
#endif
where
name' :: LocatedN RdrName
name' = RdrNameStr -> LocatedN RdrName
valueRdrName (RdrNameStr -> LocatedN RdrName) -> RdrNameStr -> LocatedN RdrName
forall a b. (a -> b) -> a -> b
$ OccNameStr -> RdrNameStr
unqual OccNameStr
name
occ :: OccName
occ = OccNameStr -> OccName
valueOccName OccNameStr
name
fixity' :: LexicalFixity
fixity' = LexicalFixity -> Maybe LexicalFixity -> LexicalFixity
forall a. a -> Maybe a -> a
fromMaybe (LexicalFixity -> LexicalFixity -> Bool -> LexicalFixity
forall a. a -> a -> Bool -> a
bool LexicalFixity
Prefix LexicalFixity
Infix (Bool -> LexicalFixity) -> Bool -> LexicalFixity
forall a b. (a -> b) -> a -> b
$ OccName -> Bool
isSymOcc OccName
occ) Maybe LexicalFixity
fixity
context :: HsMatchContext'
context = LIdP (NoGhcTc GhcPs)
-> LexicalFixity -> SrcStrictness -> HsMatchContext'
forall p.
LIdP (NoGhcTc p)
-> LexicalFixity -> SrcStrictness -> HsMatchContext p
FunRhs LIdP (NoGhcTc GhcPs)
LocatedN RdrName
name' LexicalFixity
fixity' SrcStrictness
NoSrcStrict
funBinds :: HasValBind t => OccNameStr -> [RawMatch] -> t
funBinds :: forall t. HasValBind t => OccNameStr -> [RawMatch] -> t
funBinds = Maybe LexicalFixity -> OccNameStr -> [RawMatch] -> t
forall t.
HasValBind t =>
Maybe LexicalFixity -> OccNameStr -> [RawMatch] -> t
funBindsWithFixity (LexicalFixity -> Maybe LexicalFixity
forall a. a -> Maybe a
Just LexicalFixity
Prefix)
funBind :: HasValBind t => OccNameStr -> RawMatch -> t
funBind :: forall t. HasValBind t => OccNameStr -> RawMatch -> t
funBind OccNameStr
name RawMatch
m = OccNameStr -> [RawMatch] -> t
forall t. HasValBind t => OccNameStr -> [RawMatch] -> t
funBinds OccNameStr
name [RawMatch
m]
valBindGRHSs :: HasValBind t => OccNameStr -> RawGRHSs -> t
valBindGRHSs :: forall t. HasValBind t => OccNameStr -> RawGRHSs -> t
valBindGRHSs OccNameStr
name = OccNameStr -> RawMatch -> t
forall t. HasValBind t => OccNameStr -> RawMatch -> t
funBind OccNameStr
name (RawMatch -> t) -> (RawGRHSs -> RawMatch) -> RawGRHSs -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pat'] -> RawGRHSs -> RawMatch
matchGRHSs []
valBind :: HasValBind t => OccNameStr -> HsExpr' -> t
valBind :: forall t. HasValBind t => OccNameStr -> HsExpr GhcPs -> t
valBind OccNameStr
name = OccNameStr -> RawGRHSs -> t
forall t. HasValBind t => OccNameStr -> RawGRHSs -> t
valBindGRHSs OccNameStr
name (RawGRHSs -> t) -> (HsExpr GhcPs -> RawGRHSs) -> HsExpr GhcPs -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> RawGRHSs
rhs
patBindGRHSs :: HasPatBind t => Pat' -> RawGRHSs -> t
patBindGRHSs :: forall t. HasPatBind t => Pat' -> RawGRHSs -> t
patBindGRHSs Pat'
p RawGRHSs
g =
HsBind' -> t
forall t. HasValBind t => HsBind' -> t
bindB
(HsBind' -> t) -> HsBind' -> t
forall a b. (a -> b) -> a -> b
$ HsBind' -> HsBind'
forall a. a -> a
withPlaceHolder
(HsBind' -> HsBind'
forall a. a -> a
withPlaceHolder
((EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnA Pat'
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsBind')
-> GenLocated SrcSpanAnnA Pat'
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsBind'
forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed XPatBind GhcPs GhcPs
-> LPat GhcPs -> GRHSs GhcPs (LHsExpr GhcPs) -> HsBind'
EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnA Pat'
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsBind'
forall idL idR.
XPatBind idL idR
-> LPat idL -> GRHSs idR (LHsExpr idR) -> HsBindLR idL idR
PatBind (Pat' -> LPat GhcPs
builtPat Pat'
p) (RawGRHSs -> GRHSs GhcPs (LHsExpr GhcPs)
mkGRHSs RawGRHSs
g)))
#if !MIN_VERSION_ghc(9,6,0)
$ ([],[])
#endif
patBind :: HasPatBind t => Pat' -> HsExpr' -> t
patBind :: forall t. HasPatBind t => Pat' -> HsExpr GhcPs -> t
patBind Pat'
p = Pat' -> RawGRHSs -> t
forall t. HasPatBind t => Pat' -> RawGRHSs -> t
patBindGRHSs Pat'
p (RawGRHSs -> t) -> (HsExpr GhcPs -> RawGRHSs) -> HsExpr GhcPs -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> RawGRHSs
rhs
matchGRHSs :: [Pat'] -> RawGRHSs -> RawMatch
matchGRHSs :: [Pat'] -> RawGRHSs -> RawMatch
matchGRHSs = [Pat'] -> RawGRHSs -> RawMatch
RawMatch
match :: [Pat'] -> HsExpr' -> RawMatch
match :: [Pat'] -> HsExpr GhcPs -> RawMatch
match [Pat']
ps = [Pat'] -> RawGRHSs -> RawMatch
matchGRHSs [Pat']
ps (RawGRHSs -> RawMatch)
-> (HsExpr GhcPs -> RawGRHSs) -> HsExpr GhcPs -> RawMatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> RawGRHSs
rhs
where' :: RawGRHSs -> [RawValBind] -> RawGRHSs
where' :: RawGRHSs -> [RawValBind] -> RawGRHSs
where' RawGRHSs
r [RawValBind]
vbs = RawGRHSs
r { rawGRHSWhere = rawGRHSWhere r ++ vbs }
rhs :: HsExpr' -> RawGRHSs
rhs :: HsExpr GhcPs -> RawGRHSs
rhs HsExpr GhcPs
e = [GuardedExpr] -> RawGRHSs
guardedRhs [[Stmt'] -> HsExpr GhcPs -> GuardedExpr
guards [] HsExpr GhcPs
e]
guardedRhs :: [GuardedExpr] -> RawGRHSs
guardedRhs :: [GuardedExpr] -> RawGRHSs
guardedRhs [GuardedExpr]
ss = [GuardedExpr] -> [RawValBind] -> RawGRHSs
RawGRHSs [GuardedExpr]
ss []
guard :: HsExpr' -> HsExpr' -> GuardedExpr
guard :: HsExpr GhcPs -> HsExpr GhcPs -> GuardedExpr
guard HsExpr GhcPs
s = [Stmt'] -> HsExpr GhcPs -> GuardedExpr
guards [HsExpr GhcPs -> Stmt'
stmt HsExpr GhcPs
s]
guards :: [Stmt'] -> HsExpr' -> GuardedExpr
guards :: [Stmt'] -> HsExpr GhcPs -> GuardedExpr
guards [Stmt']
stmts HsExpr GhcPs
e = (EpAnn GrhsAnn
-> [GenLocated
SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GuardLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
-> [GenLocated
SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS ((Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [GenLocated
SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated [Stmt']
[Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
stmts) (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr GhcPs
e)
stmt :: HsExpr' -> Stmt'
stmt :: HsExpr GhcPs -> Stmt'
stmt HsExpr GhcPs
e =
Stmt' -> Stmt'
forall a. a -> a
withPlaceHolder (Stmt' -> Stmt') -> Stmt' -> Stmt'
forall a b. (a -> b) -> a -> b
$ (NoExtField
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NoExtField
-> NoExtField
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NoExtField
-> NoExtField
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. (NoExtField -> a) -> a
noExt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
NoExtField
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> NoExtField
-> NoExtField
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr GhcPs
e) NoExtField
SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr NoExtField
SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
(<--) :: Pat' -> HsExpr' -> Stmt'
Pat'
p <-- :: Pat' -> HsExpr GhcPs -> Stmt'
<-- HsExpr GhcPs
e = Stmt' -> Stmt'
forall a. a -> a
withPlaceHolder (Stmt' -> Stmt') -> Stmt' -> Stmt'
forall a b. (a -> b) -> a -> b
$ (EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnA Pat'
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA Pat'
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LPat GhcPs
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnA Pat'
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt (Pat' -> LPat GhcPs
builtPat Pat'
p) (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr GhcPs
e)
#if !MIN_VERSION_ghc(9,0,0)
noSyntaxExpr noSyntaxExpr
#endif
infixl 1 <--
class HasValBind t => HasPatBind t where
instance HasPatBind RawValBind where
instance HasPatBind HsDecl' where