{-# LANGUAGE CPP #-}
module GHC.Compat.Expr (
HsExpr (..),
LHsExpr,
HsBracket (..),
HsStmtContext (..),
StmtLR (..),
ExprLStmt,
MatchGroup (..),
Match (..),
GRHSs (..),
GRHS (..),
HsMatchContext (..),
HsLocalBindsLR (..),
hsVar,
hsApps,
hsApps_RDR,
hsTyApp,
hsTyApp_RDR,
hsTyVar,
hsPar,
hsOpApp,
hsConPatArgs,
LPat,
Pat (..),
HsSplice (..),
SpliceDecoration (..),
HsCmdTop (..),
HsCmd (..),
LHsCmd,
CmdLStmt,
HsArrAppType (..),
HsTupArg (..),
HsLit (..),
HsTyLit (..),
HsOverLit (..),
OverLitVal (..),
HsType (..),
LHsType,
HsWildCardBndrs (..),
#if MIN_VERSION_ghc(8,8,0)
PromotionFlag (..),
#else
Promoted (..),
#endif
HsGroup,
HsModule,
GhcPs,
GhcRn,
Located,
GenLocated (..),
SrcSpan (..),
RealSrcSpan,
noSrcSpan,
srcSpanStartLine,
srcSpanEndLine,
srcSpanStartCol,
srcSpanEndCol,
noExtField,
nameToString,
) where
#if MIN_VERSION_ghc(8,10,0)
import GHC.Hs
#else
import HsSyn
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (PromotionFlag (..))
#elif MIN_VERSION_ghc(8,8,0)
import BasicTypes (PromotionFlag (..))
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc
(GenLocated (..), Located, RealSrcSpan, SrcSpan (..), noSrcSpan,
srcSpanEndCol, srcSpanEndLine, srcSpanStartCol, srcSpanStartLine)
#else
import SrcLoc
(GenLocated (..), Located, RealSrcSpan, SrcSpan (..), noSrcSpan,
srcSpanEndCol, srcSpanEndLine, srcSpanStartCol, srcSpanStartLine)
#endif
import Data.List (foldl')
import qualified GHC.Compat.All as GHC
#if !(MIN_VERSION_ghc(8,10,0))
noExtField :: NoExt
noExtField = noExt
#endif
hsVar :: SrcSpan -> GHC.Name -> LHsExpr GhcRn
hsVar :: SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
n = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (SrcSpan -> Name -> GenLocated SrcSpan Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
n))
hsTyVar :: SrcSpan -> GHC.Name -> HsType GhcRn
hsTyVar :: SrcSpan -> Name -> HsType GhcRn
hsTyVar SrcSpan
l Name
n = XTyVar GhcRn
-> PromotionFlag -> Located (IdP GhcRn) -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar GhcRn
noExtField PromotionFlag
NotPromoted (SrcSpan -> Name -> GenLocated SrcSpan Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
n)
hsApps :: SrcSpan -> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
hsApps :: SrcSpan -> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
hsApps SrcSpan
l = (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn)
-> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
app where
app :: LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
app :: LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
app LHsExpr GhcRn
f LHsExpr GhcRn
x = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcRn
noExtField LHsExpr GhcRn
f LHsExpr GhcRn
x)
hsApps_RDR :: SrcSpan -> LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
hsApps_RDR :: SrcSpan -> LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
hsApps_RDR SrcSpan
l = (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
app where
app :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
app :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
app LHsExpr GhcPs
f LHsExpr GhcPs
x = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcPs
noExtField LHsExpr GhcPs
f LHsExpr GhcPs
x)
hsOpApp :: SrcSpan -> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
hsOpApp :: SrcSpan
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
hsOpApp SrcSpan
l LHsExpr GhcRn
x LHsExpr GhcRn
op LHsExpr GhcRn
y = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XOpApp GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcRn
Fixity
GHC.defaultFixity LHsExpr GhcRn
x LHsExpr GhcRn
op LHsExpr GhcRn
y)
hsTyApp :: SrcSpan -> LHsExpr GhcRn -> HsType GhcRn -> LHsExpr GhcRn
#if MIN_VERSION_ghc(8,8,0)
hsTyApp :: SrcSpan -> LHsExpr GhcRn -> HsType GhcRn -> LHsExpr GhcRn
hsTyApp SrcSpan
l LHsExpr GhcRn
x HsType GhcRn
ty = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcRn -> LHsExpr GhcRn) -> HsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ XAppTypeE GhcRn
-> LHsExpr GhcRn -> LHsWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType NoExtField
XAppTypeE GhcRn
noExtField LHsExpr GhcRn
x (XHsWC GhcRn (GenLocated SrcSpan (HsType GhcRn))
-> GenLocated SrcSpan (HsType GhcRn)
-> HsWildCardBndrs GhcRn (GenLocated SrcSpan (HsType GhcRn))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC [] (SrcSpan -> HsType GhcRn -> GenLocated SrcSpan (HsType GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsType GhcRn
ty))
#else
hsTyApp l x ty = L l $ HsAppType (HsWC [] (L l ty)) x
#endif
hsTyApp_RDR :: SrcSpan -> LHsExpr GhcPs -> HsType GhcPs -> LHsExpr GhcPs
#if MIN_VERSION_ghc(8,8,0)
hsTyApp_RDR :: SrcSpan -> LHsExpr GhcPs -> HsType GhcPs -> LHsExpr GhcPs
hsTyApp_RDR SrcSpan
l LHsExpr GhcPs
x HsType GhcPs
ty = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XAppTypeE GhcPs
-> LHsExpr GhcPs -> LHsWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType NoExtField
XAppTypeE GhcPs
noExtField LHsExpr GhcPs
x (XHsWC GhcPs (GenLocated SrcSpan (HsType GhcPs))
-> GenLocated SrcSpan (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpan (HsType GhcPs))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC NoExtField
XHsWC GhcPs (GenLocated SrcSpan (HsType GhcPs))
noExtField (SrcSpan -> HsType GhcPs -> GenLocated SrcSpan (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsType GhcPs
ty))
#else
hsTyApp_RDR l x ty = L l $ HsAppType (HsWC noExtField (L l ty)) x
#endif
hsPar :: SrcSpan -> LHsExpr GhcRn -> LHsExpr GhcRn
hsPar :: SrcSpan -> LHsExpr GhcRn -> LHsExpr GhcRn
hsPar SrcSpan
l LHsExpr GhcRn
e = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XPar GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExtField
XPar GhcRn
noExtField LHsExpr GhcRn
e)
nameToString :: GHC.Name -> String
nameToString :: Name -> String
nameToString = OccName -> String
GHC.occNameString (OccName -> String) -> (Name -> OccName) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
forall name. HasOccName name => name -> OccName
GHC.occName