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
import BasicTypes (LexicalFixity(..))
import Data.Bool (bool)
import Data.Maybe (fromMaybe)
import GHC.Hs.Binds
import GHC.Hs.Expr
import GHC.Hs.Types
import GhcPlugins (isSymOcc)
import TcEvidence (HsWrapper(WpHole))
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 :: [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
$ (NoExtField -> [Located RdrName] -> LHsSigWcType' -> Sig')
-> [Located RdrName] -> LHsSigWcType' -> Sig'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> [Located RdrName] -> LHsSigWcType' -> Sig'
forall pass.
XTypeSig pass
-> [Located (IdP pass)] -> LHsSigWcType pass -> Sig pass
TypeSig ((OccNameStr -> Located RdrName)
-> [OccNameStr] -> [Located RdrName]
forall a b. (a -> b) -> [a] -> [b]
map (RdrNameStr -> Located RdrName
typeRdrName (RdrNameStr -> Located RdrName)
-> (OccNameStr -> RdrNameStr) -> OccNameStr -> Located 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 :: 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 :: 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
$ ([Tickish Id] -> HsBind') -> [Tickish Id] -> HsBind'
forall a. a -> a
withPlaceHolder
((NoExtField
-> Located RdrName
-> MatchGroup' (Located HsExpr')
-> HsWrapper
-> [Tickish Id]
-> HsBind')
-> Located RdrName
-> MatchGroup' (Located HsExpr')
-> HsWrapper
-> [Tickish Id]
-> HsBind'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> Located RdrName
-> MatchGroup' (Located HsExpr')
-> HsWrapper
-> [Tickish Id]
-> HsBind'
forall idL idR.
XFunBind idL idR
-> Located (IdP idL)
-> MatchGroup idR (LHsExpr idR)
-> HsWrapper
-> [Tickish Id]
-> HsBindLR idL idR
FunBind Located RdrName
name'
(HsMatchContext' -> [RawMatch] -> MatchGroup' (Located HsExpr')
matchGroup HsMatchContext'
context [RawMatch]
matches) HsWrapper
WpHole)
[]
where
name' :: Located RdrName
name' = RdrNameStr -> Located RdrName
valueRdrName (RdrNameStr -> Located RdrName) -> RdrNameStr -> Located 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 = Located RdrName
-> LexicalFixity -> SrcStrictness -> HsMatchContext'
forall id.
Located id -> LexicalFixity -> SrcStrictness -> HsMatchContext id
FunRhs Located RdrName
name' LexicalFixity
fixity' SrcStrictness
NoSrcStrict
funBinds :: HasValBind t => OccNameStr -> [RawMatch] -> t
funBinds :: 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 :: 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 :: 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 :: OccNameStr -> HsExpr' -> t
valBind OccNameStr
name = OccNameStr -> RawGRHSs -> t
forall t. HasValBind t => OccNameStr -> RawGRHSs -> t
valBindGRHSs OccNameStr
name (RawGRHSs -> t) -> (HsExpr' -> RawGRHSs) -> HsExpr' -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr' -> RawGRHSs
rhs
patBindGRHSs :: HasPatBind t => Pat' -> RawGRHSs -> t
patBindGRHSs :: 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
$ (([Tickish Id], [[Tickish Id]]) -> HsBind')
-> ([Tickish Id], [[Tickish Id]]) -> HsBind'
forall a. a -> a
withPlaceHolder
((([Tickish Id], [[Tickish Id]]) -> HsBind')
-> ([Tickish Id], [[Tickish Id]]) -> HsBind'
forall a. a -> a
withPlaceHolder
((NoExtField
-> GenLocated SrcSpan Pat'
-> GRHSs' (Located HsExpr')
-> ([Tickish Id], [[Tickish Id]])
-> HsBind')
-> GenLocated SrcSpan Pat'
-> GRHSs' (Located HsExpr')
-> ([Tickish Id], [[Tickish Id]])
-> HsBind'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> GenLocated SrcSpan Pat'
-> GRHSs' (Located HsExpr')
-> ([Tickish Id], [[Tickish Id]])
-> HsBind'
forall idL idR.
XPatBind idL idR
-> LPat idL
-> GRHSs idR (LHsExpr idR)
-> ([Tickish Id], [[Tickish Id]])
-> HsBindLR idL idR
PatBind (Pat' -> LPat'
builtPat Pat'
p) (RawGRHSs -> GRHSs' (Located HsExpr')
mkGRHSs RawGRHSs
g)))
(([Tickish Id], [[Tickish Id]]) -> HsBind')
-> ([Tickish Id], [[Tickish Id]]) -> HsBind'
forall a b. (a -> b) -> a -> b
$ ([],[])
patBind :: HasPatBind t => Pat' -> HsExpr' -> t
patBind :: Pat' -> HsExpr' -> t
patBind Pat'
p = Pat' -> RawGRHSs -> t
forall t. HasPatBind t => Pat' -> RawGRHSs -> t
patBindGRHSs Pat'
p (RawGRHSs -> t) -> (HsExpr' -> RawGRHSs) -> HsExpr' -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr' -> RawGRHSs
rhs
matchGRHSs :: [Pat'] -> RawGRHSs -> RawMatch
matchGRHSs :: [Pat'] -> RawGRHSs -> RawMatch
matchGRHSs = [Pat'] -> RawGRHSs -> RawMatch
RawMatch
match :: [Pat'] -> HsExpr' -> RawMatch
match :: [Pat'] -> HsExpr' -> RawMatch
match [Pat']
ps = [Pat'] -> RawGRHSs -> RawMatch
matchGRHSs [Pat']
ps (RawGRHSs -> RawMatch)
-> (HsExpr' -> RawGRHSs) -> HsExpr' -> RawMatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr' -> RawGRHSs
rhs
where' :: RawGRHSs -> [RawValBind] -> RawGRHSs
where' :: RawGRHSs -> [RawValBind] -> RawGRHSs
where' RawGRHSs
r [RawValBind]
vbs = RawGRHSs
r { rawGRHSWhere :: [RawValBind]
rawGRHSWhere = RawGRHSs -> [RawValBind]
rawGRHSWhere RawGRHSs
r [RawValBind] -> [RawValBind] -> [RawValBind]
forall a. [a] -> [a] -> [a]
++ [RawValBind]
vbs }
rhs :: HsExpr' -> RawGRHSs
rhs :: HsExpr' -> RawGRHSs
rhs HsExpr'
e = [GuardedExpr] -> RawGRHSs
guardedRhs [[Stmt'] -> HsExpr' -> GuardedExpr
guards [] HsExpr'
e]
guardedRhs :: [GuardedExpr] -> RawGRHSs
guardedRhs :: [GuardedExpr] -> RawGRHSs
guardedRhs [GuardedExpr]
ss = [GuardedExpr] -> [RawValBind] -> RawGRHSs
RawGRHSs [GuardedExpr]
ss []
guard :: HsExpr' -> HsExpr' -> GuardedExpr
guard :: HsExpr' -> HsExpr' -> GuardedExpr
guard HsExpr'
s = [Stmt'] -> HsExpr' -> GuardedExpr
guards [HsExpr' -> Stmt'
stmt HsExpr'
s]
guards :: [Stmt'] -> HsExpr' -> GuardedExpr
guards :: [Stmt'] -> HsExpr' -> GuardedExpr
guards [Stmt']
stmts HsExpr'
e = (NoExtField
-> [GuardLStmt GhcPs] -> Located HsExpr' -> GuardedExpr)
-> [GuardLStmt GhcPs] -> Located HsExpr' -> GuardedExpr
forall a. (NoExtField -> a) -> a
noExt NoExtField -> [GuardLStmt GhcPs] -> Located HsExpr' -> GuardedExpr
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS ((Stmt' -> GuardLStmt GhcPs) -> [Stmt'] -> [GuardLStmt GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map Stmt' -> GuardLStmt GhcPs
forall e. e -> Located e
builtLoc [Stmt']
stmts) (HsExpr' -> Located HsExpr'
forall e. e -> Located e
builtLoc HsExpr'
e)
stmt :: HsExpr' -> Stmt'
stmt :: HsExpr' -> Stmt'
stmt HsExpr'
e =
Stmt' -> Stmt'
forall a. a -> a
withPlaceHolder (Stmt' -> Stmt') -> Stmt' -> Stmt'
forall a b. (a -> b) -> a -> b
$ (NoExtField
-> Located HsExpr'
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> Stmt')
-> Located HsExpr' -> SyntaxExpr GhcPs -> SyntaxExpr GhcPs -> Stmt'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> Located HsExpr' -> SyntaxExpr GhcPs -> SyntaxExpr GhcPs -> Stmt'
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt (HsExpr' -> Located HsExpr'
forall e. e -> Located e
builtLoc HsExpr'
e) SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
(<--) :: Pat' -> HsExpr' -> Stmt'
Pat'
p <-- :: Pat' -> HsExpr' -> Stmt'
<-- HsExpr'
e = Stmt' -> Stmt'
forall a. a -> a
withPlaceHolder (Stmt' -> Stmt') -> Stmt' -> Stmt'
forall a b. (a -> b) -> a -> b
$ (NoExtField
-> GenLocated SrcSpan Pat'
-> Located HsExpr'
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> Stmt')
-> GenLocated SrcSpan Pat'
-> Located HsExpr'
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> Stmt'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> GenLocated SrcSpan Pat'
-> Located HsExpr'
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> Stmt'
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
BindStmt (Pat' -> LPat'
builtPat Pat'
p) (HsExpr' -> Located HsExpr'
forall e. e -> Located e
builtLoc HsExpr'
e) SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
infixl 1 <--
class HasValBind t => HasPatBind t where
instance HasPatBind RawValBind where
instance HasPatBind HsDecl' where