module Evoke.Hs ( app , bindStmt , doExpr , explicitList , explicitTuple , fieldOcc , funBind , grhs , grhss , importDecls , lam , lastStmt , lit , match , mg , opApp , par , qual , qualTyVar , qualVar , recField , recFields , recordCon , string , tupArg , tyVar , unqual , var , varPat ) where import qualified GHC.Hs as Ghc import qualified GhcPlugins as Ghc import qualified TcEvidence as Ghc app :: Ghc.SrcSpan -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs app :: SrcSpan -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs app SrcSpan s LHsExpr GhcPs f = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p Ghc.HsApp NoExtField XApp GhcPs Ghc.noExtField LHsExpr GhcPs f bindStmt :: Ghc.SrcSpan -> Ghc.LPat Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LStmt Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) bindStmt :: SrcSpan -> LPat GhcPs -> LHsExpr GhcPs -> LStmt GhcPs (LHsExpr GhcPs) bindStmt SrcSpan s LPat GhcPs p LHsExpr GhcPs e = SrcSpan -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> LStmt GhcPs (LHsExpr GhcPs) forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> LStmt GhcPs (LHsExpr GhcPs)) -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> LStmt GhcPs (LHsExpr GhcPs) forall a b. (a -> b) -> a -> b $ XBindStmt GhcPs GhcPs (LHsExpr GhcPs) -> LPat GhcPs -> LHsExpr GhcPs -> SyntaxExpr GhcPs -> SyntaxExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) forall idL idR body. XBindStmt idL idR body -> LPat idL -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body Ghc.BindStmt NoExtField XBindStmt GhcPs GhcPs (LHsExpr GhcPs) Ghc.noExtField LPat GhcPs p LHsExpr GhcPs e SyntaxExpr GhcPs noSyntaxExpr SyntaxExpr GhcPs noSyntaxExpr doExpr :: Ghc.SrcSpan -> [Ghc.ExprLStmt Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs doExpr :: SrcSpan -> [LStmt GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs doExpr SrcSpan s = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> ([LStmt GhcPs (LHsExpr GhcPs)] -> HsExpr GhcPs) -> [LStmt GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XDo GhcPs -> HsStmtContext Name -> Located [LStmt GhcPs (LHsExpr GhcPs)] -> HsExpr GhcPs forall p. XDo p -> HsStmtContext Name -> Located [ExprLStmt p] -> HsExpr p Ghc.HsDo NoExtField XDo GhcPs Ghc.noExtField HsStmtContext Name forall id. HsStmtContext id Ghc.DoExpr (Located [LStmt GhcPs (LHsExpr GhcPs)] -> HsExpr GhcPs) -> ([LStmt GhcPs (LHsExpr GhcPs)] -> Located [LStmt GhcPs (LHsExpr GhcPs)]) -> [LStmt GhcPs (LHsExpr GhcPs)] -> HsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . SrcSpan -> [LStmt GhcPs (LHsExpr GhcPs)] -> Located [LStmt GhcPs (LHsExpr GhcPs)] forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s explicitList :: Ghc.SrcSpan -> [Ghc.LHsExpr Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs explicitList :: SrcSpan -> [LHsExpr GhcPs] -> LHsExpr GhcPs explicitList SrcSpan s = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> ([LHsExpr GhcPs] -> HsExpr GhcPs) -> [LHsExpr GhcPs] -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XExplicitList GhcPs -> Maybe (SyntaxExpr GhcPs) -> [LHsExpr GhcPs] -> HsExpr GhcPs forall p. XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p Ghc.ExplicitList NoExtField XExplicitList GhcPs Ghc.noExtField Maybe (SyntaxExpr GhcPs) forall a. Maybe a Nothing explicitTuple :: Ghc.SrcSpan -> [Ghc.LHsTupArg Ghc.GhcPs] -> Ghc.LHsExpr Ghc.GhcPs explicitTuple :: SrcSpan -> [LHsTupArg GhcPs] -> LHsExpr GhcPs explicitTuple SrcSpan s [LHsTupArg GhcPs] xs = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs forall a b. (a -> b) -> a -> b $ XExplicitTuple GhcPs -> [LHsTupArg GhcPs] -> Boxity -> HsExpr GhcPs forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p Ghc.ExplicitTuple NoExtField XExplicitTuple GhcPs Ghc.noExtField [LHsTupArg GhcPs] xs Boxity Ghc.Boxed fieldOcc :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LFieldOcc Ghc.GhcPs fieldOcc :: SrcSpan -> LIdP GhcPs -> LFieldOcc GhcPs fieldOcc SrcSpan s = SrcSpan -> FieldOcc GhcPs -> LFieldOcc GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (FieldOcc GhcPs -> LFieldOcc GhcPs) -> (Located RdrName -> FieldOcc GhcPs) -> Located RdrName -> LFieldOcc GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XCFieldOcc GhcPs -> Located RdrName -> FieldOcc GhcPs forall pass. XCFieldOcc pass -> Located RdrName -> FieldOcc pass Ghc.FieldOcc NoExtField XCFieldOcc GhcPs Ghc.noExtField funBind :: Ghc.SrcSpan -> Ghc.OccName -> Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) -> Ghc.LHsBind Ghc.GhcPs funBind :: SrcSpan -> OccName -> MatchGroup GhcPs (LHsExpr GhcPs) -> LHsBind GhcPs funBind SrcSpan s OccName f MatchGroup GhcPs (LHsExpr GhcPs) g = SrcSpan -> HsBindLR GhcPs GhcPs -> LHsBind GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsBindLR GhcPs GhcPs -> LHsBind GhcPs) -> HsBindLR GhcPs GhcPs -> LHsBind GhcPs forall a b. (a -> b) -> a -> b $ XFunBind GhcPs GhcPs -> LIdP GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsWrapper -> [Tickish Id] -> HsBindLR GhcPs GhcPs forall idL idR. XFunBind idL idR -> Located (IdP idL) -> MatchGroup idR (LHsExpr idR) -> HsWrapper -> [Tickish Id] -> HsBindLR idL idR Ghc.FunBind NoExtField XFunBind GhcPs GhcPs Ghc.noExtField (SrcSpan -> OccName -> LIdP GhcPs unqual SrcSpan s OccName f) MatchGroup GhcPs (LHsExpr GhcPs) g HsWrapper Ghc.WpHole [] grhs :: Ghc.SrcSpan -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LGRHS Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) grhs :: SrcSpan -> LHsExpr GhcPs -> LGRHS GhcPs (LHsExpr GhcPs) grhs SrcSpan s = SrcSpan -> GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs) forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (GRHS GhcPs (LHsExpr GhcPs) -> LGRHS GhcPs (LHsExpr GhcPs)) -> (LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs)) -> LHsExpr GhcPs -> LGRHS GhcPs (LHsExpr GhcPs) forall b c a. (b -> c) -> (a -> b) -> a -> c . XCGRHS GhcPs (LHsExpr GhcPs) -> [LStmt GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs) forall p body. XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body Ghc.GRHS NoExtField XCGRHS GhcPs (LHsExpr GhcPs) Ghc.noExtField [] grhss :: Ghc.SrcSpan -> [Ghc.LGRHS Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)] -> Ghc.GRHSs Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) grhss :: SrcSpan -> [LGRHS GhcPs (LHsExpr GhcPs)] -> GRHSs GhcPs (LHsExpr GhcPs) grhss SrcSpan s [LGRHS GhcPs (LHsExpr GhcPs)] xs = XCGRHSs GhcPs (LHsExpr GhcPs) -> [LGRHS GhcPs (LHsExpr GhcPs)] -> LHsLocalBinds GhcPs -> GRHSs GhcPs (LHsExpr GhcPs) forall p body. XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body Ghc.GRHSs NoExtField XCGRHSs GhcPs (LHsExpr GhcPs) Ghc.noExtField [LGRHS GhcPs (LHsExpr GhcPs)] xs (LHsLocalBinds GhcPs -> GRHSs GhcPs (LHsExpr GhcPs)) -> (HsLocalBinds GhcPs -> LHsLocalBinds GhcPs) -> HsLocalBinds GhcPs -> GRHSs GhcPs (LHsExpr GhcPs) forall b c a. (b -> c) -> (a -> b) -> a -> c . SrcSpan -> HsLocalBinds GhcPs -> LHsLocalBinds GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsLocalBinds GhcPs -> GRHSs GhcPs (LHsExpr GhcPs)) -> HsLocalBinds GhcPs -> GRHSs GhcPs (LHsExpr GhcPs) forall a b. (a -> b) -> a -> b $ XEmptyLocalBinds GhcPs GhcPs -> HsLocalBinds GhcPs forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR Ghc.EmptyLocalBinds NoExtField XEmptyLocalBinds GhcPs GhcPs Ghc.noExtField importDecl :: Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.ModuleName -> Ghc.LImportDecl Ghc.GhcPs importDecl :: SrcSpan -> ModuleName -> ModuleName -> LImportDecl GhcPs importDecl SrcSpan s ModuleName m ModuleName n = SrcSpan -> ImportDecl GhcPs -> LImportDecl GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (ImportDecl GhcPs -> LImportDecl GhcPs) -> ImportDecl GhcPs -> LImportDecl GhcPs forall a b. (a -> b) -> a -> b $ XCImportDecl GhcPs -> SourceText -> Located ModuleName -> Maybe StringLiteral -> Bool -> Bool -> ImportDeclQualifiedStyle -> Bool -> Maybe (Located ModuleName) -> Maybe (Bool, Located [LIE GhcPs]) -> ImportDecl GhcPs forall pass. XCImportDecl pass -> SourceText -> Located ModuleName -> Maybe StringLiteral -> Bool -> Bool -> ImportDeclQualifiedStyle -> Bool -> Maybe (Located ModuleName) -> Maybe (Bool, Located [LIE pass]) -> ImportDecl pass Ghc.ImportDecl NoExtField XCImportDecl GhcPs Ghc.noExtField SourceText Ghc.NoSourceText (SrcSpan -> ModuleName -> Located ModuleName forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s ModuleName m) Maybe StringLiteral forall a. Maybe a Nothing Bool False Bool False ImportDeclQualifiedStyle Ghc.QualifiedPre Bool False (Located ModuleName -> Maybe (Located ModuleName) forall a. a -> Maybe a Just (Located ModuleName -> Maybe (Located ModuleName)) -> Located ModuleName -> Maybe (Located ModuleName) forall a b. (a -> b) -> a -> b $ SrcSpan -> ModuleName -> Located ModuleName forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s ModuleName n) Maybe (Bool, Located [LIE GhcPs]) forall a. Maybe a Nothing importDecls :: Ghc.SrcSpan -> [(Ghc.ModuleName, Ghc.ModuleName)] -> [Ghc.LImportDecl Ghc.GhcPs] importDecls :: SrcSpan -> [(ModuleName, ModuleName)] -> [LImportDecl GhcPs] importDecls = ((ModuleName, ModuleName) -> LImportDecl GhcPs) -> [(ModuleName, ModuleName)] -> [LImportDecl GhcPs] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (((ModuleName, ModuleName) -> LImportDecl GhcPs) -> [(ModuleName, ModuleName)] -> [LImportDecl GhcPs]) -> (SrcSpan -> (ModuleName, ModuleName) -> LImportDecl GhcPs) -> SrcSpan -> [(ModuleName, ModuleName)] -> [LImportDecl GhcPs] forall b c a. (b -> c) -> (a -> b) -> a -> c . (ModuleName -> ModuleName -> LImportDecl GhcPs) -> (ModuleName, ModuleName) -> LImportDecl GhcPs forall a b c. (a -> b -> c) -> (a, b) -> c uncurry ((ModuleName -> ModuleName -> LImportDecl GhcPs) -> (ModuleName, ModuleName) -> LImportDecl GhcPs) -> (SrcSpan -> ModuleName -> ModuleName -> LImportDecl GhcPs) -> SrcSpan -> (ModuleName, ModuleName) -> LImportDecl GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . SrcSpan -> ModuleName -> ModuleName -> LImportDecl GhcPs importDecl lam :: Ghc.SrcSpan -> Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) -> Ghc.LHsExpr Ghc.GhcPs lam :: SrcSpan -> MatchGroup GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs lam SrcSpan s = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> (MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs) -> MatchGroup GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XLam GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p Ghc.HsLam NoExtField XLam GhcPs Ghc.noExtField lastStmt :: Ghc.SrcSpan -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LStmt Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) lastStmt :: SrcSpan -> LHsExpr GhcPs -> LStmt GhcPs (LHsExpr GhcPs) lastStmt SrcSpan s LHsExpr GhcPs e = SrcSpan -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> LStmt GhcPs (LHsExpr GhcPs) forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> LStmt GhcPs (LHsExpr GhcPs)) -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> LStmt GhcPs (LHsExpr GhcPs) forall a b. (a -> b) -> a -> b $ XLastStmt GhcPs GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool -> SyntaxExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) forall idL idR body. XLastStmt idL idR body -> body -> Bool -> SyntaxExpr idR -> StmtLR idL idR body Ghc.LastStmt NoExtField XLastStmt GhcPs GhcPs (LHsExpr GhcPs) Ghc.noExtField LHsExpr GhcPs e Bool False SyntaxExpr GhcPs noSyntaxExpr lit :: Ghc.SrcSpan -> Ghc.HsLit Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs lit :: SrcSpan -> HsLit GhcPs -> LHsExpr GhcPs lit SrcSpan s = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> (HsLit GhcPs -> HsExpr GhcPs) -> HsLit GhcPs -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XLitE GhcPs -> HsLit GhcPs -> HsExpr GhcPs forall p. XLitE p -> HsLit p -> HsExpr p Ghc.HsLit NoExtField XLitE GhcPs Ghc.noExtField noSyntaxExpr :: Ghc.SyntaxExpr Ghc.GhcPs noSyntaxExpr :: SyntaxExpr GhcPs noSyntaxExpr = HsExpr GhcPs -> [HsWrapper] -> HsWrapper -> SyntaxExpr GhcPs forall p. HsExpr p -> [HsWrapper] -> HsWrapper -> SyntaxExpr p Ghc.SyntaxExpr HsExpr GhcPs forall (p :: Pass). HsExpr (GhcPass p) Ghc.noExpr [] HsWrapper Ghc.WpHole match :: Ghc.SrcSpan -> Ghc.HsMatchContext Ghc.RdrName -> [Ghc.LPat Ghc.GhcPs] -> Ghc.GRHSs Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) -> Ghc.LMatch Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) match :: SrcSpan -> HsMatchContext RdrName -> [LPat GhcPs] -> GRHSs GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs) match SrcSpan s HsMatchContext RdrName c [LPat GhcPs] ps = SrcSpan -> Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs) forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (Match GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs)) -> (GRHSs GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs)) -> GRHSs GhcPs (LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs) forall b c a. (b -> c) -> (a -> b) -> a -> c . XCMatch GhcPs (LHsExpr GhcPs) -> HsMatchContext (NameOrRdrName (IdP GhcPs)) -> [LPat GhcPs] -> GRHSs GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs) forall p body. XCMatch p body -> HsMatchContext (NameOrRdrName (IdP p)) -> [LPat p] -> GRHSs p body -> Match p body Ghc.Match NoExtField XCMatch GhcPs (LHsExpr GhcPs) Ghc.noExtField HsMatchContext (NameOrRdrName (IdP GhcPs)) HsMatchContext RdrName c [LPat GhcPs] ps mg :: Ghc.Located [Ghc.LMatch Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)] -> Ghc.MatchGroup Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) mg :: Located [LMatch GhcPs (LHsExpr GhcPs)] -> MatchGroup GhcPs (LHsExpr GhcPs) mg Located [LMatch GhcPs (LHsExpr GhcPs)] ms = XMG GhcPs (LHsExpr GhcPs) -> Located [LMatch GhcPs (LHsExpr GhcPs)] -> Origin -> MatchGroup GhcPs (LHsExpr GhcPs) forall p body. XMG p body -> Located [LMatch p body] -> Origin -> MatchGroup p body Ghc.MG NoExtField XMG GhcPs (LHsExpr GhcPs) Ghc.noExtField Located [LMatch GhcPs (LHsExpr GhcPs)] ms Origin Ghc.Generated opApp :: Ghc.SrcSpan -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs opApp :: SrcSpan -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs opApp SrcSpan s LHsExpr GhcPs l LHsExpr GhcPs o = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XOpApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs forall p. XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p Ghc.OpApp NoExtField XOpApp GhcPs Ghc.noExtField LHsExpr GhcPs l LHsExpr GhcPs o par :: Ghc.SrcSpan -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs par :: SrcSpan -> LHsExpr GhcPs -> LHsExpr GhcPs par SrcSpan s = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs forall p. XPar p -> LHsExpr p -> HsExpr p Ghc.HsPar NoExtField XPar GhcPs Ghc.noExtField qual :: Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.OccName -> Ghc.LIdP Ghc.GhcPs qual :: SrcSpan -> ModuleName -> OccName -> LIdP GhcPs qual SrcSpan s ModuleName m = SrcSpan -> RdrName -> Located RdrName forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (RdrName -> Located RdrName) -> (OccName -> RdrName) -> OccName -> Located RdrName forall b c a. (b -> c) -> (a -> b) -> a -> c . ModuleName -> OccName -> RdrName Ghc.mkRdrQual ModuleName m qualTyVar :: Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.OccName -> Ghc.LHsType Ghc.GhcPs qualTyVar :: SrcSpan -> ModuleName -> OccName -> LHsType GhcPs qualTyVar SrcSpan s ModuleName m = SrcSpan -> LIdP GhcPs -> LHsType GhcPs tyVar SrcSpan s (Located RdrName -> LHsType GhcPs) -> (OccName -> Located RdrName) -> OccName -> LHsType GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . SrcSpan -> ModuleName -> OccName -> LIdP GhcPs qual SrcSpan s ModuleName m qualVar :: Ghc.SrcSpan -> Ghc.ModuleName -> Ghc.OccName -> Ghc.LHsExpr Ghc.GhcPs qualVar :: SrcSpan -> ModuleName -> OccName -> LHsExpr GhcPs qualVar SrcSpan s ModuleName m = SrcSpan -> LIdP GhcPs -> LHsExpr GhcPs var SrcSpan s (Located RdrName -> LHsExpr GhcPs) -> (OccName -> Located RdrName) -> OccName -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . SrcSpan -> ModuleName -> OccName -> LIdP GhcPs qual SrcSpan s ModuleName m recFields :: [Ghc.LHsRecField Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs)] -> Ghc.HsRecFields Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) recFields :: [LHsRecField GhcPs (LHsExpr GhcPs)] -> HsRecFields GhcPs (LHsExpr GhcPs) recFields = ([LHsRecField GhcPs (LHsExpr GhcPs)] -> Maybe (Located Int) -> HsRecFields GhcPs (LHsExpr GhcPs)) -> Maybe (Located Int) -> [LHsRecField GhcPs (LHsExpr GhcPs)] -> HsRecFields GhcPs (LHsExpr GhcPs) forall a b c. (a -> b -> c) -> b -> a -> c flip [LHsRecField GhcPs (LHsExpr GhcPs)] -> Maybe (Located Int) -> HsRecFields GhcPs (LHsExpr GhcPs) forall p arg. [LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg Ghc.HsRecFields Maybe (Located Int) forall a. Maybe a Nothing recField :: Ghc.SrcSpan -> Ghc.LFieldOcc Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsRecField Ghc.GhcPs (Ghc.LHsExpr Ghc.GhcPs) recField :: SrcSpan -> LFieldOcc GhcPs -> LHsExpr GhcPs -> LHsRecField GhcPs (LHsExpr GhcPs) recField SrcSpan s LFieldOcc GhcPs f LHsExpr GhcPs e = SrcSpan -> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs) -> LHsRecField GhcPs (LHsExpr GhcPs) forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs) -> LHsRecField GhcPs (LHsExpr GhcPs)) -> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs) -> LHsRecField GhcPs (LHsExpr GhcPs) forall a b. (a -> b) -> a -> b $ LFieldOcc GhcPs -> LHsExpr GhcPs -> Bool -> HsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs) forall id arg. Located id -> arg -> Bool -> HsRecField' id arg Ghc.HsRecField LFieldOcc GhcPs f LHsExpr GhcPs e Bool False recordCon :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.HsRecordBinds Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs recordCon :: SrcSpan -> LIdP GhcPs -> HsRecFields GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs recordCon SrcSpan s LIdP GhcPs c = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> (HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs) -> HsRecFields GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XRecordCon GhcPs -> LIdP GhcPs -> HsRecFields GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs forall p. XRecordCon p -> Located (IdP p) -> HsRecordBinds p -> HsExpr p Ghc.RecordCon NoExtField XRecordCon GhcPs Ghc.noExtField LIdP GhcPs c string :: String -> Ghc.HsLit Ghc.GhcPs string :: String -> HsLit GhcPs string = XHsString GhcPs -> FastString -> HsLit GhcPs forall x. XHsString x -> FastString -> HsLit x Ghc.HsString XHsString GhcPs SourceText Ghc.NoSourceText (FastString -> HsLit GhcPs) -> (String -> FastString) -> String -> HsLit GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> FastString Ghc.mkFastString tupArg :: Ghc.SrcSpan -> Ghc.LHsExpr Ghc.GhcPs -> Ghc.LHsTupArg Ghc.GhcPs tupArg :: SrcSpan -> LHsExpr GhcPs -> LHsTupArg GhcPs tupArg SrcSpan s = SrcSpan -> HsTupArg GhcPs -> LHsTupArg GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsTupArg GhcPs -> LHsTupArg GhcPs) -> (LHsExpr GhcPs -> HsTupArg GhcPs) -> LHsExpr GhcPs -> LHsTupArg GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs forall id. XPresent id -> LHsExpr id -> HsTupArg id Ghc.Present NoExtField XPresent GhcPs Ghc.noExtField tyVar :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LHsType Ghc.GhcPs tyVar :: SrcSpan -> LIdP GhcPs -> LHsType GhcPs tyVar SrcSpan s = SrcSpan -> HsType GhcPs -> LHsType GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsType GhcPs -> LHsType GhcPs) -> (Located RdrName -> HsType GhcPs) -> Located RdrName -> LHsType GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs forall pass. XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass Ghc.HsTyVar NoExtField XTyVar GhcPs Ghc.noExtField PromotionFlag Ghc.NotPromoted unqual :: Ghc.SrcSpan -> Ghc.OccName -> Ghc.LIdP Ghc.GhcPs unqual :: SrcSpan -> OccName -> LIdP GhcPs unqual SrcSpan s = SrcSpan -> RdrName -> Located RdrName forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (RdrName -> Located RdrName) -> (OccName -> RdrName) -> OccName -> Located RdrName forall b c a. (b -> c) -> (a -> b) -> a -> c . OccName -> RdrName Ghc.mkRdrUnqual var :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LHsExpr Ghc.GhcPs var :: SrcSpan -> LIdP GhcPs -> LHsExpr GhcPs var SrcSpan s = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (HsExpr GhcPs -> LHsExpr GhcPs) -> (Located RdrName -> HsExpr GhcPs) -> Located RdrName -> LHsExpr GhcPs forall b c a. (b -> c) -> (a -> b) -> a -> c . XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs forall p. XVar p -> Located (IdP p) -> HsExpr p Ghc.HsVar NoExtField XVar GhcPs Ghc.noExtField varPat :: Ghc.SrcSpan -> Ghc.LIdP Ghc.GhcPs -> Ghc.LPat Ghc.GhcPs varPat :: SrcSpan -> LIdP GhcPs -> LPat GhcPs varPat SrcSpan s = SrcSpan -> Pat GhcPs -> GenLocated SrcSpan (Pat GhcPs) forall l e. l -> e -> GenLocated l e Ghc.L SrcSpan s (Pat GhcPs -> GenLocated SrcSpan (Pat GhcPs)) -> (Located RdrName -> Pat GhcPs) -> Located RdrName -> GenLocated SrcSpan (Pat GhcPs) forall b c a. (b -> c) -> (a -> b) -> a -> c . XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs forall p. XVarPat p -> Located (IdP p) -> Pat p Ghc.VarPat NoExtField XVarPat GhcPs Ghc.noExtField