{-# LANGUAGE CPP #-}
module GHC.SourceGen.Expr
( HsExpr'
, overLabel
, let'
, case'
, lambda
, lambdaCase
, if'
, multiIf
, do'
, listComp
, Stmt'
, (@::@)
, tyApp
, recordConE
, recordUpd
, from
, fromThen
, fromTo
, fromThenTo
) where
import GHC.Hs.Expr
import GHC.Hs.Extension (GhcPs)
#if MIN_VERSION_ghc(9,6,0)
import GHC.Hs.Extension (noHsTok)
import GHC.Types.SourceText (SourceText(NoSourceText))
#endif
#if MIN_VERSION_ghc(9,4,0)
import GHC.Hs.Pat (HsFieldBind(..), HsRecFields(..))
#else
import GHC.Hs.Pat (HsRecField'(..), HsRecFields(..))
#endif
import GHC.Hs.Type (FieldOcc(..), AmbiguousFieldOcc(..))
import GHC.Hs.Utils (mkHsIf)
import Data.String (fromString)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc (unLoc, GenLocated(..))
#else
import SrcLoc (unLoc, GenLocated(..))
#endif
#if MIN_VERSION_ghc(9,2,0)
import GHC.Parser.Annotation (EpAnn(..))
#endif
import GHC.SourceGen.Binds.Internal
import GHC.SourceGen.Binds
import GHC.SourceGen.Expr.Internal
import GHC.SourceGen.Name.Internal
import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Type.Internal
( parenthesizeTypeForApp
, sigWcType
, wcType
)
overLabel :: String -> HsExpr'
overLabel :: String -> HsExpr'
overLabel = FastString -> HsExpr'
hsOverLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
where
#if MIN_VERSION_ghc(9,6,0)
hsOverLabel = withEpAnnNotUsed HsOverLabel NoSourceText
#elif MIN_VERSION_ghc(9,2,0)
hsOverLabel :: FastString -> HsExpr'
hsOverLabel = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XOverLabel p -> FastString -> HsExpr p
HsOverLabel
#else
hsOverLabel = noExt HsOverLabel Nothing
#endif
let' :: [RawValBind] -> HsExpr' -> HsExpr'
#if MIN_VERSION_ghc(9,4,0)
let' binds e = withEpAnnNotUsed HsLet mkToken (toHsLocalBinds $ valBinds binds) mkToken $ mkLocated e
#else
let' :: [RawValBind] -> HsExpr' -> HsExpr'
let' [RawValBind]
binds HsExpr'
e = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XLet p -> HsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet (forall {a}. a -> a
toHsLocalBinds forall a b. (a -> b) -> a -> b
$ [RawValBind] -> HsLocalBinds'
valBinds [RawValBind]
binds) forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e
#endif
where
#if MIN_VERSION_ghc(9,2,0)
toHsLocalBinds :: a -> a
toHsLocalBinds = forall {a}. a -> a
id
#else
toHsLocalBinds = builtLoc
#endif
case' :: HsExpr' -> [RawMatch] -> HsExpr'
case' :: HsExpr' -> [RawMatch] -> HsExpr'
case' HsExpr'
e [RawMatch]
matches = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e)
forall a b. (a -> b) -> a -> b
$ HsMatchContext' -> [RawMatch] -> MatchGroup' LHsExpr'
matchGroup forall p. HsMatchContext p
CaseAlt [RawMatch]
matches
lambda :: [Pat'] -> HsExpr' -> HsExpr'
lambda :: [Pat'] -> HsExpr' -> HsExpr'
lambda [Pat']
ps HsExpr'
e = forall a. (NoExtField -> a) -> a
noExt forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam forall a b. (a -> b) -> a -> b
$ HsMatchContext' -> [RawMatch] -> MatchGroup' LHsExpr'
matchGroup forall p. HsMatchContext p
LambdaExpr [[Pat'] -> HsExpr' -> RawMatch
match [Pat']
ps HsExpr'
e]
lambdaCase :: [RawMatch] -> HsExpr'
#if MIN_VERSION_ghc(9,4,0)
lambdaCase = withEpAnnNotUsed HsLamCase LamCase . matchGroup CaseAlt
#else
lambdaCase :: [RawMatch] -> HsExpr'
lambdaCase = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsMatchContext' -> [RawMatch] -> MatchGroup' LHsExpr'
matchGroup forall p. HsMatchContext p
CaseAlt
#endif
if' :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
if' :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
if' HsExpr'
x HsExpr'
y HsExpr'
z = LHsExpr' -> LHsExpr' -> LHsExpr' -> EpAnn AnnsIf -> HsExpr'
mkHsIf
(forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
x)
(forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
y)
(forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
z)
#if MIN_VERSION_ghc(9,2,0)
forall ann. EpAnn ann
EpAnnNotUsed
#endif
multiIf :: [GuardedExpr] -> HsExpr'
#if MIN_VERSION_ghc(9,4,0)
multiIf = withPlaceHolder (withEpAnnNotUsed HsMultiIf) . map mkLocated
#else
multiIf :: [GuardedExpr] -> HsExpr'
multiIf = forall {a}. a -> a
withPlaceHolder (forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall e. e -> Located e
builtLoc
#endif
do' :: [Stmt'] -> HsExpr'
do' :: [Stmt'] -> HsExpr'
do' = forall {a}. a -> a
withPlaceHolder
#if MIN_VERSION_ghc(9,0,0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p.
XDo p
-> HsStmtContext (HsDoRn p) -> XRec p [ExprLStmt p] -> HsExpr p
HsDo (forall p. Maybe ModuleName -> HsStmtContext p
DoExpr forall a. Maybe a
Nothing)
#else
. noExt HsDo DoExpr
#endif
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {idL} {idR}.
StmtLR idL idR (GenLocated SrcSpanAnnA HsExpr')
-> StmtLR idL idR (GenLocated SrcSpanAnnA HsExpr')
parenthesizeIfLet)
where
#if MIN_VERSION_ghc(8,6,0)
parenthesizeIfLet :: StmtLR idL idR (GenLocated SrcSpanAnnA HsExpr')
-> StmtLR idL idR (GenLocated SrcSpanAnnA HsExpr')
parenthesizeIfLet (BodyStmt XBodyStmt idL idR (GenLocated SrcSpanAnnA HsExpr')
ext e :: GenLocated SrcSpanAnnA HsExpr'
e@(L SrcSpanAnnA
_ HsLet{}) SyntaxExpr idR
x SyntaxExpr idR
y)
= forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt idL idR (GenLocated SrcSpanAnnA HsExpr')
ext (LHsExpr' -> LHsExpr'
parExpr GenLocated SrcSpanAnnA HsExpr'
e) SyntaxExpr idR
x SyntaxExpr idR
y
#else
parenthesizeIfLet (BodyStmt e@(L _ HsLet{}) x y tc)
= BodyStmt (parExpr e) x y tc
#endif
parenthesizeIfLet StmtLR idL idR (GenLocated SrcSpanAnnA HsExpr')
s = StmtLR idL idR (GenLocated SrcSpanAnnA HsExpr')
s
listComp :: HsExpr' -> [Stmt'] -> HsExpr'
listComp :: HsExpr' -> [Stmt'] -> HsExpr'
listComp HsExpr'
lastExpr [Stmt']
stmts =
let lastStmt :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA HsExpr')
lastStmt = forall a. (NoExtField -> a) -> a
noExt forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
lastExpr) forall a. Maybe a
ret forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
#if MIN_VERSION_ghc(9,0,0)
ret :: Maybe a
ret = forall a. Maybe a
Nothing
#else
ret = False
#endif
in forall {a}. a -> a
withPlaceHolder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p.
XDo p
-> HsStmtContext (HsDoRn p) -> XRec p [ExprLStmt p] -> HsExpr p
HsDo forall p. HsStmtContext p
ListComp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated 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 forall a b. (a -> b) -> a -> b
$
[Stmt']
stmts forall a. [a] -> [a] -> [a]
++ [StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA HsExpr')
lastStmt]
(@::@) :: HsExpr' -> HsType' -> HsExpr'
#if MIN_VERSION_ghc(8,8,0)
HsExpr'
e @::@ :: HsExpr' -> HsType' -> HsExpr'
@::@ HsType'
t = forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e) (HsType' -> LHsSigWcType'
sigWcType HsType'
t)
#elif MIN_VERSION_ghc(8,6,0)
e @::@ t = ExprWithTySig (sigWcType t) (builtLoc e)
#else
e @::@ t = ExprWithTySig (builtLoc e) (sigWcType t)
#endif
tyApp :: HsExpr' -> HsType' -> HsExpr'
#if MIN_VERSION_ghc(9,6,0)
tyApp e t = noExt HsAppType e' noHsTok t'
#elif MIN_VERSION_ghc(9,2,0)
tyApp :: HsExpr' -> HsType' -> HsExpr'
tyApp HsExpr'
e HsType'
t = forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType SrcSpan
builtSpan forall {ann}. GenLocated (SrcSpanAnn ann) HsExpr'
e' HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA HsType')
t'
#elif MIN_VERSION_ghc(8,8,0)
tyApp e t = noExt HsAppType e' t'
#elif MIN_VERSION_ghc(8,6,0)
tyApp e t = HsAppType t' e'
#else
tyApp e t = HsAppType e' t'
#endif
where
t' :: LHsWcType'
t' = HsType' -> LHsWcType'
wcType forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> LHsType GhcPs
parenthesizeTypeForApp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsType'
t
e' :: GenLocated (SrcSpanAnn ann) HsExpr'
e' = forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e
recordConE :: RdrNameStr -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordConE :: RdrNameStr -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordConE RdrNameStr
c [(RdrNameStr, HsExpr')]
fs = (forall {a}. a -> a
withPlaceHolder forall a b. (a -> b) -> a -> b
$ forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p.
XRecordCon p -> XRec p (ConLikeP p) -> HsRecordBinds p -> HsExpr p
RecordCon (RdrNameStr -> LocatedN RdrName
valueRdrName RdrNameStr
c))
#if !MIN_VERSION_ghc(8,6,0)
noPostTcExpr
#endif
forall a b. (a -> b) -> a -> b
$ forall p arg.
[LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
HsRecFields (forall a b. (a -> b) -> [a] -> [b]
map (RdrNameStr, HsExpr') -> LHsRecField' LHsExpr'
recField [(RdrNameStr, HsExpr')]
fs)
forall a. Maybe a
Nothing
where
recField :: (RdrNameStr, HsExpr') -> LHsRecField' LHsExpr'
recField :: (RdrNameStr, HsExpr') -> LHsRecField' LHsExpr'
recField (RdrNameStr
f, HsExpr'
e) =
#if MIN_VERSION_ghc(9,4,0)
mkLocated HsFieldBind
{ hfbLHS =
mkLocated $ withPlaceHolder $ noExt FieldOcc $ valueRdrName f
, hfbRHS = mkLocated e
, hfbPun = False
, hfbAnn = EpAnnNotUsed
#else
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsRecField
{ hsRecFieldLbl :: Located (FieldOcc GhcPs)
hsRecFieldLbl =
forall e. e -> Located e
builtLoc forall a b. (a -> b) -> a -> b
$ forall {a}. a -> a
withPlaceHolder forall a b. (a -> b) -> a -> b
$ forall a. (NoExtField -> a) -> a
noExt forall pass. XCFieldOcc pass -> LocatedN RdrName -> FieldOcc pass
FieldOcc forall a b. (a -> b) -> a -> b
$ RdrNameStr -> LocatedN RdrName
valueRdrName RdrNameStr
f
, hsRecFieldArg :: GenLocated SrcSpanAnnA HsExpr'
hsRecFieldArg = forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e
, hsRecPun :: Bool
hsRecPun = Bool
False
#if MIN_VERSION_ghc(9,2,0)
, hsRecFieldAnn :: XHsRecField (FieldOcc GhcPs)
hsRecFieldAnn = forall ann. EpAnn ann
EpAnnNotUsed
#endif
#endif
}
recordUpd :: HsExpr' -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordUpd :: HsExpr' -> [(RdrNameStr, HsExpr')] -> HsExpr'
recordUpd HsExpr'
e [(RdrNameStr, HsExpr')]
fs =
forall {a}. a -> a
withPlaceHolder4
forall a b. (a -> b) -> a -> b
$ forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p.
XRecordUpd p
-> LHsExpr p
-> Either [LHsRecUpdField p] [LHsRecUpdProj p]
-> HsExpr p
RecordUpd (LHsExpr' -> LHsExpr'
parenthesizeExprForApp forall a b. (a -> b) -> a -> b
$ forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e)
forall a b. (a -> b) -> a -> b
$ forall {a} {b}. a -> Either a b
toRecordUpdFields forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (RdrNameStr, HsExpr') -> LHsRecUpdField'
mkField [(RdrNameStr, HsExpr')]
fs
where
mkField :: (RdrNameStr, HsExpr') -> LHsRecUpdField'
mkField :: (RdrNameStr, HsExpr') -> LHsRecUpdField'
mkField (RdrNameStr
f, HsExpr'
e') =
#if MIN_VERSION_ghc(9,4,0)
mkLocated HsFieldBind
{ hfbLHS =
mkLocated $ withPlaceHolder $ noExt Ambiguous $ valueRdrName f
, hfbRHS = mkLocated e'
, hfbPun = False
, hfbAnn = EpAnnNotUsed
#else
forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsRecField
{ hsRecFieldLbl :: Located (AmbiguousFieldOcc GhcPs)
hsRecFieldLbl =
forall e. e -> Located e
builtLoc forall a b. (a -> b) -> a -> b
$ forall {a}. a -> a
withPlaceHolder forall a b. (a -> b) -> a -> b
$ forall a. (NoExtField -> a) -> a
noExt forall pass.
XAmbiguous pass -> LocatedN RdrName -> AmbiguousFieldOcc pass
Ambiguous forall a b. (a -> b) -> a -> b
$ RdrNameStr -> LocatedN RdrName
valueRdrName RdrNameStr
f
, hsRecFieldArg :: GenLocated SrcSpanAnnA HsExpr'
hsRecFieldArg = forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
e'
, hsRecPun :: Bool
hsRecPun = Bool
False
#if MIN_VERSION_ghc(9,2,0)
, hsRecFieldAnn :: XHsRecField (AmbiguousFieldOcc GhcPs)
hsRecFieldAnn = forall ann. EpAnn ann
EpAnnNotUsed
#endif
#endif
}
withPlaceHolder4 :: c -> c
withPlaceHolder4 = forall {a}. a -> a
withPlaceHolder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. a -> a
withPlaceHolder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. a -> a
withPlaceHolder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. a -> a
withPlaceHolder
#if MIN_VERSION_ghc(9,2,0)
toRecordUpdFields :: a -> Either a b
toRecordUpdFields = forall {a} {b}. a -> Either a b
Left
#else
toRecordUpdFields = id
#endif
arithSeq :: ArithSeqInfo GhcPs -> HsExpr'
arithSeq :: ArithSeqInfo GhcPs -> HsExpr'
arithSeq =
#if MIN_VERSION_ghc(8,6,0)
forall ann a. (EpAnn ann -> a) -> a
withEpAnnNotUsed forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq forall a. Maybe a
Nothing
#else
ArithSeq noPostTcExpr Nothing
#endif
from :: HsExpr' -> HsExpr'
from :: HsExpr' -> HsExpr'
from HsExpr'
from' = ArithSeqInfo GhcPs -> HsExpr'
arithSeq forall a b. (a -> b) -> a -> b
$ forall id. LHsExpr id -> ArithSeqInfo id
From (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
from')
fromThen :: HsExpr' -> HsExpr' -> HsExpr'
fromThen :: HsExpr' -> HsExpr' -> HsExpr'
fromThen HsExpr'
from' HsExpr'
then' = ArithSeqInfo GhcPs -> HsExpr'
arithSeq forall a b. (a -> b) -> a -> b
$ forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThen (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
from') (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
then')
fromTo :: HsExpr' -> HsExpr' -> HsExpr'
fromTo :: HsExpr' -> HsExpr' -> HsExpr'
fromTo HsExpr'
from' HsExpr'
to = ArithSeqInfo GhcPs -> HsExpr'
arithSeq forall a b. (a -> b) -> a -> b
$ forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromTo (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
from') (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
to)
fromThenTo :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
fromThenTo :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
fromThenTo HsExpr'
from' HsExpr'
then' HsExpr'
to =
ArithSeqInfo GhcPs -> HsExpr'
arithSeq forall a b. (a -> b) -> a -> b
$ forall id.
LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThenTo (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
from') (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
then') (forall a ann. a -> GenLocated (SrcSpanAnn ann) a
mkLocated HsExpr'
to)