ghc-source-gen 0.4.2.0 → 0.4.3.0
raw patch · 18 files changed
+574/−256 lines, 18 filesdep ~ghcPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: ghc
API changes (from Hackage documentation)
- GHC.SourceGen.Binds: type GuardedExpr = GRHS' (Located HsExpr')
+ GHC.SourceGen.Binds: type GuardedExpr = GRHS' LHsExpr'
- GHC.SourceGen.Expr: type Stmt' = Stmt GhcPs (Located HsExpr')
+ GHC.SourceGen.Expr: type Stmt' = Stmt GhcPs LHsExpr'
Files
- ChangeLog.md +3/−0
- ghc-source-gen.cabal +5/−5
- src/GHC/SourceGen/Binds.hs +9/−5
- src/GHC/SourceGen/Binds/Internal.hs +18/−14
- src/GHC/SourceGen/Decl.hs +166/−56
- src/GHC/SourceGen/Expr.hs +66/−31
- src/GHC/SourceGen/Expr/Internal.hs +5/−5
- src/GHC/SourceGen/Lit.hs +17/−11
- src/GHC/SourceGen/Lit/Internal.hs +3/−1
- src/GHC/SourceGen/Module.hs +21/−13
- src/GHC/SourceGen/Name/Internal.hs +35/−11
- src/GHC/SourceGen/Overloaded.hs +44/−34
- src/GHC/SourceGen/Pat.hs +22/−11
- src/GHC/SourceGen/Pat/Internal.hs +8/−3
- src/GHC/SourceGen/Pretty.hs +4/−0
- src/GHC/SourceGen/Syntax/Internal.hs +106/−27
- src/GHC/SourceGen/Type.hs +25/−17
- src/GHC/SourceGen/Type/Internal.hs +17/−12
ChangeLog.md view
@@ -1,5 +1,8 @@ # Changelog for haskell-syntax +# 0.4.3.0+- Support GHC 9.2.+ # 0.4.2.0 - Support GHC 9.
ghc-source-gen.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: ghc-source-gen-version: 0.4.2.0+version: 0.4.3.0 synopsis: Constructs Haskell syntax trees for the GHC API. description: @ghc-source-gen@ is a library for generating Haskell source code. It uses the <https://hackage.haskell.org/package/ghc ghc> library@@ -61,7 +61,7 @@ TypeSynonymInstances build-depends: base >=4.7 && <5- , ghc >=8.4 && <9.2+ , ghc >=8.4 && <9.3 if impl(ghc<8.10) other-modules: GHC.Hs@@ -110,7 +110,7 @@ build-depends: QuickCheck >=2.10 && <2.15 , base >=4.7 && <5- , ghc >=8.4 && <9.2+ , ghc >=8.4 && <9.3 , ghc-source-gen , tasty >=1.0 && <1.5 , tasty-hunit ==0.10.*@@ -131,7 +131,7 @@ TypeSynonymInstances build-depends: base >=4.7 && <5- , ghc >=8.4 && <9.2+ , ghc >=8.4 && <9.3 , ghc-paths ==0.1.* , ghc-source-gen , tasty >=1.0 && <1.5@@ -157,7 +157,7 @@ TypeSynonymInstances build-depends: base >=4.7 && <5- , ghc >=8.4 && <9.2+ , ghc >=8.4 && <9.3 , ghc-paths ==0.1.* , ghc-source-gen , tasty >=1.0 && <1.5
src/GHC/SourceGen/Binds.hs view
@@ -46,7 +46,11 @@ , (<--) ) 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@@ -69,7 +73,7 @@ -- > typeSigs ["f", "g"] (var "A") typeSigs :: HasValBind t => [OccNameStr] -> HsType' -> t typeSigs names t =- sigB $ noExt TypeSig (map (typeRdrName . unqual) names)+ sigB $ withEpAnnNotUsed TypeSig (map (typeRdrName . unqual) names) $ sigWcType t -- | Declares the type of a single function or value.@@ -184,7 +188,7 @@ bindB $ withPlaceHolder (withPlaceHolder- (noExt PatBind (builtPat p) (mkGRHSs g)))+ (withEpAnnNotUsed PatBind (builtPat p) (mkGRHSs g))) $ ([],[]) -- | Defines a pattern binding without any guards.@@ -277,7 +281,7 @@ -- > ===== -- > guards [conP "Just" (bvar "x") <-- var "y", bvar "x"] unit guards :: [Stmt'] -> HsExpr' -> GuardedExpr-guards stmts e = noExt GRHS (map builtLoc stmts) (builtLoc e)+guards stmts e = withEpAnnNotUsed GRHS (map mkLocated stmts) (mkLocated e) -- | An expression statement. May be used in a do expression (with 'do'') or in a -- match (with 'guard').@@ -286,7 +290,7 @@ stmt :: HsExpr' -> Stmt' -- For now, don't worry about rebindable syntax. stmt e =- withPlaceHolder $ noExt BodyStmt (builtLoc e) noSyntaxExpr noSyntaxExpr+ withPlaceHolder $ noExt BodyStmt (mkLocated e) noSyntaxExpr noSyntaxExpr -- | A statement that binds a pattern. --@@ -294,7 +298,7 @@ -- > ===== -- > bvar "x" <-- var "act" (<--) :: Pat' -> HsExpr' -> Stmt'-p <-- e = withPlaceHolder $ noExt BindStmt (builtPat p) (builtLoc e)+p <-- e = withPlaceHolder $ withEpAnnNotUsed BindStmt (builtPat p) (mkLocated e) #if !MIN_VERSION_ghc(9,0,0) noSyntaxExpr noSyntaxExpr #endif
src/GHC/SourceGen/Binds/Internal.hs view
@@ -10,11 +10,9 @@ #if MIN_VERSION_ghc(9,0,0) import GHC.Types.Basic (Origin(Generated)) import GHC.Data.Bag (listToBag)-import GHC.Types.SrcLoc (Located) #else import BasicTypes (Origin(Generated)) import Bag (listToBag)-import SrcLoc (Located) #endif import GHC.Hs.Binds import GHC.Hs.Decls@@ -40,14 +38,14 @@ -- This case prevents GHC from printing an empty "where" clause: valBinds [] = noExt EmptyLocalBinds valBinds vbs =- noExt HsValBinds+ withEpAnnNotUsed HsValBinds #if MIN_VERSION_ghc(8,6,0)- $ noExt ValBinds+ $ withNoAnnSortKey ValBinds #else $ noExt ValBindsIn #endif- (listToBag $ map builtLoc binds)- (map builtLoc sigs)+ (listToBag $ map mkLocated binds)+ (map mkLocated sigs) where sigs = [s | SigV s <- vbs] binds = [b | BindV b <- vbs]@@ -83,30 +81,36 @@ , rawGRHSWhere :: [RawValBind] } -matchGroup :: HsMatchContext' -> [RawMatch] -> MatchGroup' (Located HsExpr')+matchGroup :: HsMatchContext' -> [RawMatch] -> MatchGroup' LHsExpr' matchGroup context matches =- noExt MG (builtLoc $ map (builtLoc . mkMatch) matches)+ noExt MG (mkLocated $ map (mkLocated . mkMatch) matches) #if !MIN_VERSION_ghc(8,6,0) [] PlaceHolder #endif Generated where- mkMatch :: RawMatch -> Match' (Located HsExpr')- mkMatch r = noExt Match context+ mkMatch :: RawMatch -> Match' LHsExpr'+ mkMatch r = withEpAnnNotUsed Match context (map builtPat $ map parenthesize $ rawMatchPats r) (mkGRHSs $ rawMatchGRHSs r) -mkGRHSs :: RawGRHSs -> GRHSs' (Located HsExpr')-mkGRHSs g = noExt GRHSs+mkGRHSs :: RawGRHSs -> GRHSs' LHsExpr'+mkGRHSs g = withEmptyEpAnnComments GRHSs (map builtLoc $ rawGRHSs g)- (builtLoc $ valBinds $ rawGRHSWhere g)+ (fromLocalBinds $ valBinds $ rawGRHSWhere g)+ where+#if MIN_VERSION_ghc(9,2,0)+ fromLocalBinds = id+#else+ fromLocalBinds = builtLoc+#endif -- | An expression with a single guard. -- -- For example: -- -- > | otherwise = ()-type GuardedExpr = GRHS' (Located HsExpr')+type GuardedExpr = GRHS' LHsExpr' -- | Syntax types which can declare/define functions. For example: -- declarations, or the body of a class declaration or class instance.
src/GHC/SourceGen/Decl.hs view
@@ -5,6 +5,8 @@ -- https://developers.google.com/open-source/licenses/bsd {-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+ -- | This module provides combinators for constructing Haskell declarations. module GHC.SourceGen.Decl ( HsDecl'@@ -50,17 +52,17 @@ ) where #if MIN_VERSION_ghc(9,0,0)-import GHC.Types.Basic (LexicalFixity(Prefix))+import GHC (LexicalFixity(Prefix)) import GHC.Data.Bag (listToBag)-import GHC.Types.SrcLoc (Located, LayoutInfo(..))+import GHC.Types.SrcLoc (LayoutInfo(..)) #else import BasicTypes (LexicalFixity(Prefix)) import Bag (listToBag)-import SrcLoc (Located) #endif #if !MIN_VERSION_ghc(8,6,0) import BasicTypes (DerivStrategy(..)) #endif+import GHC (GhcPs) import GHC.Hs.Binds import GHC.Hs.Decls @@ -68,9 +70,15 @@ ( ConDeclField(..) , FieldOcc(..) , HsConDetails(..)+#if !MIN_VERSION_ghc(9,2,0) , HsImplicitBndrs (..)+#endif+#if MIN_VERSION_ghc(9,2,0)+ , HsOuterTyVarBndrs (..)+#endif , HsSrcBang(..) , HsType(..)+ , LHsType #if MIN_VERSION_ghc(8,6,0) , HsWildCardBndrs (..) #endif@@ -84,7 +92,9 @@ #endif ) -#if MIN_VERSION_ghc(8,10,0)+#if MIN_VERSION_ghc(9,2,0)+import GHC.Parser.Annotation (AnnSortKey(..), EpAnn(..))+#elif MIN_VERSION_ghc(8,10,0) import GHC.Hs.Extension (NoExtField(NoExtField)) #elif MIN_VERSION_ghc(8,6,0) import GHC.Hs.Extension (NoExt(NoExt))@@ -163,8 +173,10 @@ -> HsDecl' class' context name vars decls = noExt TyClD $ ClassDecl- { tcdCtxt = builtLoc $ map builtLoc context-#if MIN_VERSION_ghc(9,0,0)+ { tcdCtxt = toHsContext $ mkLocated $ map mkLocated context+#if MIN_VERSION_ghc(9,2,0)+ , tcdCExt = (EpAnnNotUsed, NoAnnSortKey, NoLayoutInfo)+#elif MIN_VERSION_ghc(9,0,0) , tcdCExt = NoLayoutInfo #elif MIN_VERSION_ghc(8,10,0) , tcdCExt = NoExtField@@ -176,16 +188,27 @@ , tcdLName = typeRdrName $ unqual name , tcdTyVars = mkQTyVars vars , tcdFixity = Prefix- , tcdFDs = [ builtLoc (map typeRdrName xs, map typeRdrName ys)+ , tcdFDs = [ mkLocated $ funDep' (map typeRdrName xs) (map typeRdrName ys) | ClassFunDep xs ys <- decls ]- , tcdSigs = [builtLoc sig | ClassSig sig <- decls]+ , tcdSigs = [mkLocated sig | ClassSig sig <- decls] , tcdMeths =- listToBag [builtLoc bind | ClassDefaultMethod bind <- decls]+ listToBag [mkLocated bind | ClassDefaultMethod bind <- decls] , tcdATs = [] -- Associated types , tcdATDefs = [] -- Associated type defaults , tcdDocs = [] -- Haddocks }+ where+#if MIN_VERSION_ghc(9,2,0)+ funDep' = withEpAnnNotUsed FunDep+#else+ funDep' = (,)+#endif+#if MIN_VERSION_ghc(9,2,0)+ toHsContext = Just+#else+ toHsContext = id+#endif -- | A definition that can appear in the body of an @instance@ declaration. --@@ -217,14 +240,16 @@ instance' :: HsType' -> [RawInstDecl] -> HsDecl' instance' ty decls = noExt InstD $ noExt ClsInstD $ ClsInstDecl { cid_poly_ty = sigType ty-#if MIN_VERSION_ghc(8,10,0)+#if MIN_VERSION_ghc(9,2,0)+ , cid_ext = (EpAnnNotUsed, NoAnnSortKey)+#elif MIN_VERSION_ghc(8,10,0) , cid_ext = NoExtField #elif MIN_VERSION_ghc(8,6,0) , cid_ext = NoExt #endif- , cid_binds = listToBag [builtLoc b | InstBind b <- decls]- , cid_sigs = [builtLoc sig | InstSig sig <- decls]- , cid_tyfam_insts = [builtLoc $ t | InstTyFam t <- decls]+ , cid_binds = listToBag [mkLocated b | InstBind b <- decls]+ , cid_sigs = [mkLocated sig | InstSig sig <- decls]+ , cid_tyfam_insts = [mkLocated $ t | InstTyFam t <- decls] , cid_datafam_insts = [] , cid_overlap_mode = Nothing }@@ -248,17 +273,31 @@ -- > tyFamInst "Elt" [var "String"] (var "Char") tyFamInst :: HasTyFamInst t => RdrNameStr -> [HsType'] -> HsType' -> t tyFamInst name params ty = tyFamInstD- $ TyFamInstDecl- $ implicitBndrs- $ noExt FamEqn (typeRdrName name)-#if MIN_VERSION_ghc(8,8,0)- Nothing -- eqn binders- (map (HsValArg . builtLoc) params)+ $ tyFamInstDecl+ $ famEqn+ (typeRdrName name)+ eqn_bndrs+ (map mkLocated params)+ Prefix+ (mkLocated ty)+ where+#if MIN_VERSION_ghc(9,2,0)+ tyFamInstDecl = withEpAnnNotUsed TyFamInstDecl #else- (map builtLoc params)+ tyFamInstDecl = TyFamInstDecl . withPlaceHolder . noExt (withPlaceHolder HsIB) #endif- Prefix- (builtLoc ty)+#if MIN_VERSION_ghc(9,2,0)+ famEqn tycon bndrs pats = withEpAnnNotUsed FamEqn tycon bndrs (map HsValArg pats)+#elif MIN_VERSION_ghc(8,8,0)+ famEqn tycon bndrs pats = noExt FamEqn tycon bndrs (map HsValArg pats)+#else+ famEqn tycon _ = noExt FamEqn tycon+#endif+#if MIN_VERSION_ghc(9,2,0)+ eqn_bndrs = noExt HsOuterImplicit+#else+ eqn_bndrs = Nothing+#endif -- | Declares a type synonym. --@@ -267,10 +306,10 @@ -- > type' "A" [bvar "a", bvar "b"] $ var "B" @@ var "b" @@ var "a" type' :: OccNameStr -> [HsTyVarBndr'] -> HsType' -> HsDecl' type' name vars t =- noExt TyClD $ withPlaceHolder $ noExt SynDecl (typeRdrName $ unqual name)+ noExt TyClD $ withPlaceHolder $ withEpAnnNotUsed SynDecl (typeRdrName $ unqual name) (mkQTyVars vars) Prefix- (builtLoc t)+ (mkLocated t) newOrDataType :: NewOrData@@ -281,14 +320,26 @@ -> HsDecl' newOrDataType newOrData name vars conDecls derivs = noExt TyClD $ withPlaceHolder $ withPlaceHolder $- noExt DataDecl (typeRdrName $ unqual name)+ withEpAnnNotUsed DataDecl (typeRdrName $ unqual name) (mkQTyVars vars) Prefix $ noExt HsDataDefn newOrData- (builtLoc []) Nothing+ cxt Nothing- (map builtLoc conDecls)- (builtLoc $ map builtLoc derivs)+ Nothing+ (map mkLocated conDecls)+ (toHsDeriving $ map builtLoc derivs)+ where+#if MIN_VERSION_ghc(9,2,0)+ cxt = Nothing+#else+ cxt = builtLoc []+#endif+#if MIN_VERSION_ghc(9,2,0)+ toHsDeriving = id+#else+ toHsDeriving = mkLocated+#endif -- | A newtype declaration. --@@ -321,7 +372,13 @@ -- > prefixCon "Foo" [field (var "a"), field (var "Int")] prefixCon :: OccNameStr -> [Field] -> ConDecl' prefixCon name fields = renderCon98Decl name- $ PrefixCon $ map (hsUnrestricted . renderField) fields+ $ prefixCon' $ map (hsUnrestricted . renderField) fields+ where+#if MIN_VERSION_ghc(9,2,0)+ prefixCon' = PrefixCon []+#else+ prefixCon' = PrefixCon+#endif -- | Declares a Haskell-98-style infix constructor for a data or type -- declaration.@@ -341,10 +398,10 @@ -- > recordCon "A" [("x", var "B"), ("y", var "C")] recordCon :: OccNameStr -> [(OccNameStr, Field)] -> ConDecl' recordCon name fields = renderCon98Decl name- $ RecCon $ builtLoc $ map mkLConDeclField fields+ $ RecCon $ mkLocated $ map mkLConDeclField fields where mkLConDeclField (n, f) =- builtLoc $ noExt ConDeclField+ mkLocated $ withEpAnnNotUsed ConDeclField [builtLoc $ withPlaceHolder $ noExt FieldOcc $ valueRdrName $ unqual n] (renderField f) Nothing@@ -388,42 +445,67 @@ hsUnrestricted = id #endif -renderField :: Field -> Located HsType'+renderField :: Field -> LHsType GhcPs -- TODO: parenthesizeTypeForApp is an overestimate in the case of -- rendering an infix or record type.-renderField f = wrap $ parenthesizeTypeForApp $ builtLoc $ fieldType f+renderField f = wrap $ parenthesizeTypeForApp $ mkLocated $ fieldType f where wrap = case strictness f of NoSrcStrict -> id- s -> builtLoc . (noExt HsBangTy $ noSourceText HsSrcBang NoSrcUnpack s)+ s -> mkLocated . (withEpAnnNotUsed HsBangTy $ noSourceText HsSrcBang NoSrcUnpack s) renderCon98Decl :: OccNameStr -> HsConDeclDetails' -> ConDecl'-renderCon98Decl name details = noExt ConDeclH98 (typeRdrName $ unqual name)-#if MIN_VERSION_ghc(8,6,0)- (builtLoc False)- []+renderCon98Decl name details =+ conDeclH98 (typeRdrName $ unqual name) False [] Nothing details Nothing+ where+#if MIN_VERSION_ghc(9,2,0)+ conDeclH98 = withEpAnnNotUsed ConDeclH98+#elif MIN_VERSION_ghc(8,6,0)+ conDeclH98 n = noExt ConDeclH98 n . builtLoc #else- Nothing+ conDeclH98 n _ _ = ConDeclH98 n Nothing #endif- Nothing- details- Nothing deriving' :: [HsType'] -> HsDerivingClause' deriving' = derivingWay Nothing derivingWay :: Maybe DerivStrategy' -> [HsType'] -> HsDerivingClause' derivingWay way ts =- noExt HsDerivingClause (fmap builtLoc way) $ builtLoc $ map sigType ts+ withEpAnnNotUsed HsDerivingClause (fmap builtLoc way) $ mkLocated $ derivClauseTys $ map sigType ts+ where+#if MIN_VERSION_ghc(9,2,0)+ derivClauseTys [x] = noExt DctSingle x+ derivClauseTys xs = noExt DctMulti xs+#else+ derivClauseTys = id+#endif derivingStock :: [HsType'] -> HsDerivingClause'-derivingStock = derivingWay (Just StockStrategy)+derivingStock = derivingWay (Just strat)+ where+#if MIN_VERSION_ghc(9,2,0)+ strat = withEpAnnNotUsed StockStrategy+#else+ strat = StockStrategy+#endif derivingNewtype :: [HsType'] -> HsDerivingClause'-derivingNewtype = derivingWay (Just NewtypeStrategy)+derivingNewtype = derivingWay (Just strat)+ where+#if MIN_VERSION_ghc(9,2,0)+ strat = withEpAnnNotUsed NewtypeStrategy+#else+ strat = NewtypeStrategy+#endif derivingAnyclass :: [HsType'] -> HsDerivingClause'-derivingAnyclass = derivingWay (Just AnyclassStrategy)+derivingAnyclass = derivingWay (Just strat)+ where+#if MIN_VERSION_ghc(9,2,0)+ strat = withEpAnnNotUsed AnyclassStrategy+#else+ strat = AnyclassStrategy+#endif #if MIN_VERSION_ghc(8,6,0) -- | A `DerivingVia` clause.@@ -433,27 +515,49 @@ -- > derivingVia (var "T") [var "Eq", var "Show"] -- Available with @ghc>=8.6@. derivingVia :: HsType' -> [HsType'] -> HsDerivingClause'-derivingVia t = derivingWay (Just $ ViaStrategy $ sigType t)+derivingVia t = derivingWay (Just $ strat $ sigType t)+ where+#if MIN_VERSION_ghc(9,2,0)+ strat = ViaStrategy . withEpAnnNotUsed XViaStrategyPs+#else+ strat = ViaStrategy #endif+#endif standaloneDeriving :: HsType' -> HsDecl' standaloneDeriving = standaloneDerivingWay Nothing standaloneDerivingStock :: HsType' -> HsDecl'-standaloneDerivingStock = standaloneDerivingWay (Just StockStrategy)+standaloneDerivingStock = standaloneDerivingWay (Just strat)+ where+#if MIN_VERSION_ghc(9,2,0)+ strat = withEpAnnNotUsed StockStrategy+#else+ strat = StockStrategy+#endif standaloneDerivingNewtype :: HsType' -> HsDecl'-standaloneDerivingNewtype = standaloneDerivingWay (Just NewtypeStrategy)+standaloneDerivingNewtype = standaloneDerivingWay (Just strat)+ where+#if MIN_VERSION_ghc(9,2,0)+ strat = withEpAnnNotUsed NewtypeStrategy+#else+ strat = NewtypeStrategy+#endif standaloneDerivingAnyclass :: HsType' -> HsDecl'-standaloneDerivingAnyclass = standaloneDerivingWay (Just AnyclassStrategy)+standaloneDerivingAnyclass = standaloneDerivingWay (Just strat)+ where+#if MIN_VERSION_ghc(9,2,0)+ strat = withEpAnnNotUsed AnyclassStrategy+#else+ strat = AnyclassStrategy+#endif standaloneDerivingWay :: Maybe DerivStrategy' -> HsType' -> HsDecl' standaloneDerivingWay way ty = noExt DerivD derivDecl where derivDecl =- noExt DerivDecl (hsWC hsIB) (fmap builtLoc way) Nothing- hsIB =- withPlaceHolder $ noExtOrPlaceHolder HsIB (builtLoc ty)+ withEpAnnNotUsed DerivDecl (hsWC $ sigType ty) (fmap builtLoc way) Nothing hsWC = #if MIN_VERSION_ghc(8,6,0) noExt HsWC@@ -468,7 +572,7 @@ -- > patSynSigs ["F", "G"] $ var "T" patSynSigs :: [OccNameStr] -> HsType' -> HsDecl' patSynSigs names t =- sigB $ noExt PatSynSig (map (typeRdrName . unqual) names)+ sigB $ withEpAnnNotUsed PatSynSig (map (typeRdrName . unqual) names) $ sigType t -- | Declares a pattern signature and its type.@@ -488,8 +592,14 @@ -- > patSynBind "F" ["a", "b"] $ conP "G" [bvar "b", bvar "a"] patSynBind :: OccNameStr -> [OccNameStr] -> Pat' -> HsDecl' patSynBind n ns p = bindB $ noExt PatSynBind- $ withPlaceHolder (noExt PSB (valueRdrName $ unqual n))- (PrefixCon (map (valueRdrName . unqual) ns))+ $ withPlaceHolder (withEpAnnNotUsed PSB (valueRdrName $ unqual n))+ (prefixCon' (map (valueRdrName . unqual) ns)) (builtPat p) ImplicitBidirectional+ where+#if MIN_VERSION_ghc(9,2,0)+ prefixCon' = PrefixCon []+#else+ prefixCon' = PrefixCon+#endif
src/GHC/SourceGen/Expr.hs view
@@ -35,11 +35,15 @@ import GHC.Hs.Utils (mkHsIf) import Data.String (fromString) #if MIN_VERSION_ghc(9,0,0)-import GHC.Types.SrcLoc (unLoc, GenLocated(..), Located)+import GHC.Types.SrcLoc (unLoc, GenLocated(..)) #else-import SrcLoc (unLoc, GenLocated(..), Located)+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@@ -57,23 +61,41 @@ -- > ===== -- > overLabel "foo" overLabel :: String -> HsExpr'-overLabel = noExt HsOverLabel Nothing . fromString+overLabel = hsOverLabel . fromString+ where+#if MIN_VERSION_ghc(9,2,0)+ hsOverLabel = withEpAnnNotUsed HsOverLabel+#else+ hsOverLabel = noExt HsOverLabel Nothing+#endif let' :: [RawValBind] -> HsExpr' -> HsExpr'-let' binds e = noExt HsLet (builtLoc $ valBinds binds) $ builtLoc e+let' binds e = withEpAnnNotUsed HsLet (toHsLocalBinds $ valBinds binds) $ mkLocated e+ where+#if MIN_VERSION_ghc(9,2,0)+ toHsLocalBinds = id+#else+ toHsLocalBinds = builtLoc+#endif case' :: HsExpr' -> [RawMatch] -> HsExpr'-case' e matches = noExt HsCase (builtLoc e)+case' e matches = withEpAnnNotUsed HsCase (mkLocated e) $ matchGroup CaseAlt matches lambda :: [Pat'] -> HsExpr' -> HsExpr' lambda ps e = noExt HsLam $ matchGroup LambdaExpr [match ps e] lambdaCase :: [RawMatch] -> HsExpr'-lambdaCase = noExt HsLamCase . matchGroup CaseAlt+lambdaCase = withEpAnnNotUsed HsLamCase . matchGroup CaseAlt if' :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'-if' x y z = mkHsIf (builtLoc x) (builtLoc y) (builtLoc z)+if' x y z = mkHsIf+ (mkLocated x)+ (mkLocated y)+ (mkLocated z)+#if MIN_VERSION_ghc(9,2,0)+ EpAnnNotUsed+#endif -- | A MultiWayIf expression. --@@ -87,7 +109,7 @@ -- > , guardedStmt (var "otherwise") $ rhs (string "h") -- > ] multiIf :: [GuardedExpr] -> HsExpr'-multiIf = noExtOrPlaceHolder HsMultiIf . map builtLoc+multiIf = withPlaceHolder (withEpAnnNotUsed HsMultiIf) . map builtLoc -- | A do-expression. --@@ -101,11 +123,11 @@ do' :: [Stmt'] -> HsExpr' do' = withPlaceHolder #if MIN_VERSION_ghc(9,0,0)- . noExt HsDo (DoExpr Nothing)+ . withEpAnnNotUsed HsDo (DoExpr Nothing) #else . noExt HsDo DoExpr #endif- . builtLoc . map (builtLoc . parenthesizeIfLet)+ . mkLocated . map (mkLocated . parenthesizeIfLet) where -- Put parentheses around a "let" in a do-binding, to avoid: -- do let x = ...@@ -130,13 +152,13 @@ -- > ] listComp :: HsExpr' -> [Stmt'] -> HsExpr' listComp lastExpr stmts =- let lastStmt = noExt LastStmt (builtLoc lastExpr) ret noSyntaxExpr+ let lastStmt = noExt LastStmt (mkLocated lastExpr) ret noSyntaxExpr #if MIN_VERSION_ghc(9,0,0) ret = Nothing #else ret = False #endif- in withPlaceHolder . noExt HsDo ListComp . builtLoc . map builtLoc $+ in withPlaceHolder . withEpAnnNotUsed HsDo ListComp . mkLocated . map mkLocated $ stmts ++ [lastStmt] -- | A type constraint on an expression.@@ -146,7 +168,7 @@ -- > var "e" @::@ var "t" (@::@) :: HsExpr' -> HsType' -> HsExpr' #if MIN_VERSION_ghc(8,8,0)-e @::@ t = noExt ExprWithTySig (builtLoc e) (sigWcType t)+e @::@ t = withEpAnnNotUsed ExprWithTySig (mkLocated e) (sigWcType t) #elif MIN_VERSION_ghc(8,6,0) e @::@ t = ExprWithTySig (sigWcType t) (builtLoc e) #else@@ -160,7 +182,9 @@ -- > ===== -- > var "f" @@ var "Int" tyApp :: HsExpr' -> HsType' -> HsExpr'-#if MIN_VERSION_ghc(8,8,0)+#if MIN_VERSION_ghc(9,2,0)+tyApp e t = HsAppType builtSpan e' 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'@@ -168,8 +192,8 @@ tyApp e t = HsAppType e' t' #endif where- t' = wcType $ unLoc $ parenthesizeTypeForApp $ builtLoc t- e' = builtLoc e+ t' = wcType $ unLoc $ parenthesizeTypeForApp $ mkLocated t+ e' = mkLocated e -- | Constructs a record with explicit field names. --@@ -177,20 +201,23 @@ -- > ===== -- > recordConE "A" [("x", var "y")] recordConE :: RdrNameStr -> [(RdrNameStr, HsExpr')] -> HsExpr'-recordConE c fs = (withPlaceHolder $ noExt RecordCon (valueRdrName c))+recordConE c fs = (withPlaceHolder $ withEpAnnNotUsed RecordCon (valueRdrName c)) #if !MIN_VERSION_ghc(8,6,0) noPostTcExpr #endif $ HsRecFields (map recField fs) Nothing -- No ".." where- recField :: (RdrNameStr, HsExpr') -> LHsRecField' (Located HsExpr')+ recField :: (RdrNameStr, HsExpr') -> LHsRecField' LHsExpr' recField (f, e) =- builtLoc HsRecField+ mkLocated HsRecField { hsRecFieldLbl = builtLoc $ withPlaceHolder $ noExt FieldOcc $ valueRdrName f- , hsRecFieldArg = builtLoc e+ , hsRecFieldArg = mkLocated e , hsRecPun = False+#if MIN_VERSION_ghc(9,2,0)+ , hsRecFieldAnn = EpAnnNotUsed+#endif } -- | Updates a record expression with explicit field names.@@ -209,26 +236,34 @@ recordUpd :: HsExpr' -> [(RdrNameStr, HsExpr')] -> HsExpr' recordUpd e fs = withPlaceHolder4- $ noExt RecordUpd (parenthesizeExprForApp $ builtLoc e)- $ map mkField fs+ $ withEpAnnNotUsed RecordUpd (parenthesizeExprForApp $ mkLocated e)+ $ toRecordUpdFields $ map mkField fs where mkField :: (RdrNameStr, HsExpr') -> LHsRecUpdField' mkField (f, e') =- builtLoc HsRecField+ mkLocated HsRecField { hsRecFieldLbl = builtLoc $ withPlaceHolder $ noExt Ambiguous $ valueRdrName f- , hsRecFieldArg = builtLoc e'+ , hsRecFieldArg = mkLocated e' , hsRecPun = False+#if MIN_VERSION_ghc(9,2,0)+ , hsRecFieldAnn = EpAnnNotUsed+#endif } withPlaceHolder4 = withPlaceHolder . withPlaceHolder . withPlaceHolder . withPlaceHolder+#if MIN_VERSION_ghc(9,2,0)+ toRecordUpdFields = Left+#else+ toRecordUpdFields = id+#endif arithSeq :: ArithSeqInfo GhcPs -> HsExpr' arithSeq =-#if !MIN_VERSION_ghc(8,6,0)- ArithSeq noPostTcExpr Nothing+#if MIN_VERSION_ghc(8,6,0)+ withEpAnnNotUsed ArithSeq Nothing #else- noExt ArithSeq Nothing+ ArithSeq noPostTcExpr Nothing #endif -- | An arithmetic sequence expression with a start value.@@ -237,7 +272,7 @@ -- > ===== -- > from (var "a") from :: HsExpr' -> HsExpr'-from from' = arithSeq $ From (builtLoc from')+from from' = arithSeq $ From (mkLocated from') -- | An arithmetic sequence expression with a start and a step values. --@@ -245,7 +280,7 @@ -- > ===== -- > fromThen (var "a") (var "b") fromThen :: HsExpr' -> HsExpr' -> HsExpr'-fromThen from' then' = arithSeq $ FromThen (builtLoc from') (builtLoc then')+fromThen from' then' = arithSeq $ FromThen (mkLocated from') (mkLocated then') -- | An arithmetic sequence expression with a start and an end values. --@@ -253,7 +288,7 @@ -- > ===== -- > fromTo (var "a") (var "b") fromTo :: HsExpr' -> HsExpr' -> HsExpr'-fromTo from' to = arithSeq $ FromTo (builtLoc from') (builtLoc to)+fromTo from' to = arithSeq $ FromTo (mkLocated from') (mkLocated to) -- | An arithmetic sequence expression with a start, a step, and an end values. --@@ -262,4 +297,4 @@ -- > fromThenTo (var "a") (var "b") (var "c") fromThenTo :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr' fromThenTo from' then' to =- arithSeq $ FromThenTo (builtLoc from') (builtLoc then') (builtLoc to)+ arithSeq $ FromThenTo (mkLocated from') (mkLocated then') (mkLocated to)
src/GHC/SourceGen/Expr/Internal.hs view
@@ -9,16 +9,16 @@ import GHC.Hs.Expr #if MIN_VERSION_ghc(9,0,0)-import GHC.Types.SrcLoc (Located, unLoc)+import GHC.Types.SrcLoc (unLoc) #else-import SrcLoc (Located, unLoc)+import SrcLoc (unLoc) #endif import GHC.SourceGen.Lit.Internal import GHC.SourceGen.Syntax.Internal parenthesizeExprForApp, parenthesizeExprForOp- :: Located HsExpr' -> Located HsExpr'+ :: LHsExpr' -> LHsExpr' parenthesizeExprForApp e | needsExprForApp (unLoc e) = parExpr e | otherwise = e@@ -26,8 +26,8 @@ | needsExprForOp (unLoc e) = parExpr e | otherwise = e -parExpr :: Located HsExpr' -> Located HsExpr'-parExpr = builtLoc . noExt HsPar+parExpr :: LHsExpr' -> LHsExpr'+parExpr = mkLocated . withEpAnnNotUsed HsPar #if MIN_VERSION_ghc(8,6,0) #define WILD_EXT _
src/GHC/SourceGen/Lit.hs view
@@ -17,11 +17,14 @@ , frac ) where -#if MIN_VERSION_ghc(9,0,0)-import GHC.Types.Basic (FractionalLit(..), IntegralLit(..), SourceText(..))+#if MIN_VERSION_ghc(9,2,0)+import GHC.Types.SourceText (mkTHFractionalLit, mkIntegralLit) import GHC.Data.FastString (fsLit)+#elif MIN_VERSION_ghc(9,0,0)+import GHC.Types.Basic (mkFractionalLit, mkIntegralLit)+import GHC.Data.FastString (fsLit) #else-import BasicTypes (FractionalLit(..), IntegralLit(..), SourceText(..))+import BasicTypes (mkFractionalLit, mkIntegralLit) import FastString (fsLit) #endif import GHC.Hs.Lit@@ -36,13 +39,13 @@ overLit :: HsOverLit' -> e instance HasLit HsExpr' where- lit = noExt HsLit- overLit = noExt HsOverLit+ lit = withEpAnnNotUsed HsLit+ overLit = withEpAnnNotUsed HsOverLit instance HasLit Pat' where lit = noExt LitPat overLit l = withPlaceHolder- $ noExt NPat (builtLoc l) Nothing noSyntaxExpr+ $ withEpAnnNotUsed NPat (builtLoc l) Nothing noSyntaxExpr char :: HasLit e => Char -> e char = lit . noSourceText HsChar@@ -52,13 +55,16 @@ -- | Note: this is an *overloaded* integer. int :: HasLit e => Integer -> e-int n = overLit $ withPlaceHolder $ withPlaceHolder (noExt OverLit il) noExpr+int n = overLit $ withPlaceHolder $ withPlaceHolder (noExt OverLit n') noExpr where- il = HsIntegral $ noSourceText IL (n < 0) n+ n' = HsIntegral $ mkIntegralLit n -- | Note: this is an *overloaded* rational, e.g., a decimal number. frac :: HasLit e => Rational -> e-frac x = overLit $ withPlaceHolder $ withPlaceHolder (noExt OverLit $ HsFractional il) noExpr+frac x = overLit $ withPlaceHolder $ withPlaceHolder (noExt OverLit $ HsFractional x') noExpr where- il = FL (SourceText s) (x < 0) x- s = show (fromRational x :: Double)+#if MIN_VERSION_ghc(9,2,0)+ x' = mkTHFractionalLit x+#else+ x' = mkFractionalLit x+#endif
src/GHC/SourceGen/Lit/Internal.hs view
@@ -7,7 +7,9 @@ {-# LANGUAGE CPP #-} module GHC.SourceGen.Lit.Internal where -#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0)+import GHC.Types.SourceText (SourceText(NoSourceText), FractionalLit(..), IntegralLit(..))+#elif MIN_VERSION_ghc(9,0,0) import GHC.Types.Basic (SourceText(NoSourceText), FractionalLit(..), IntegralLit(..)) #else import BasicTypes (SourceText(NoSourceText), FractionalLit(..), IntegralLit(..))
src/GHC/SourceGen/Module.hs view
@@ -33,6 +33,9 @@ #if MIN_VERSION_ghc(8,10,0) , ImportDeclQualifiedStyle(..) #endif+#if MIN_VERSION_ghc(9,2,0)+ , EpAnn(..)+#endif ) #if MIN_VERSION_ghc(9,0,0) import GHC.Types.SrcLoc (LayoutInfo(..))@@ -54,15 +57,18 @@ -> [HsDecl'] -> HsModule' module' name exports imports decls = HsModule- { hsmodName = fmap (builtLoc . unModuleNameStr) name- , hsmodExports = fmap (builtLoc . map builtLoc) exports- , hsmodImports = map builtLoc imports- , hsmodDecls = fmap builtLoc decls+ { hsmodName = fmap (mkLocated . unModuleNameStr) name+ , hsmodExports = fmap (mkLocated . map mkLocated) exports+ , hsmodImports = map mkLocated imports+ , hsmodDecls = fmap mkLocated decls , hsmodDeprecMessage = Nothing , hsmodHaddockModHeader = Nothing #if MIN_VERSION_ghc(9,0,0) , hsmodLayout = NoLayoutInfo #endif+#if MIN_VERSION_ghc(9,2,0)+ , hsmodAnn = EpAnnNotUsed+#endif } qualified' :: ImportDecl' -> ImportDecl'@@ -75,11 +81,11 @@ } as' :: ImportDecl' -> ModuleNameStr -> ImportDecl'-as' d m = d { ideclAs = Just (builtLoc $ unModuleNameStr m) }+as' d m = d { ideclAs = Just (mkLocated $ unModuleNameStr m) } import' :: ModuleNameStr -> ImportDecl'-import' m = noSourceText (noExt ImportDecl)- (builtLoc $ unModuleNameStr m)+import' m = noSourceText (withEpAnnNotUsed ImportDecl)+ (mkLocated $ unModuleNameStr m) Nothing #if MIN_VERSION_ghc(9,0,0) NotBoot@@ -96,11 +102,11 @@ exposing :: ImportDecl' -> [IE'] -> ImportDecl' exposing d ies = d- { ideclHiding = Just (False, builtLoc $ map builtLoc ies) }+ { ideclHiding = Just (False, mkLocated $ map mkLocated ies) } hiding :: ImportDecl' -> [IE'] -> ImportDecl' hiding d ies = d- { ideclHiding = Just (True, builtLoc $ map builtLoc ies) }+ { ideclHiding = Just (True, mkLocated $ map mkLocated ies) } -- | Adds the @{-# SOURCE #-}@ pragma to an import. source :: ImportDecl' -> ImportDecl'@@ -118,7 +124,7 @@ -- > ===== -- > thingAll "A" thingAll :: RdrNameStr -> IE'-thingAll = noExt IEThingAll . wrappedName+thingAll = withEpAnnNotUsed IEThingAll . wrappedName -- | Exports specific methods and/or constructors. --@@ -126,17 +132,19 @@ -- > ===== -- > thingWith "A" ["b", "C"] thingWith :: RdrNameStr -> [OccNameStr] -> IE'-thingWith n cs = noExt IEThingWith (wrappedName n) NoIEWildcard+thingWith n cs = withEpAnnNotUsed IEThingWith (wrappedName n) NoIEWildcard (map (wrappedName . unqual) cs)+#if !MIN_VERSION_ghc(9,2,0) -- The parsing step leaves the list of fields empty -- and lumps them all together with the above list of -- constructors. []+#endif -- TODO: support "mixed" syntax with both ".." and explicit names. wrappedName :: RdrNameStr -> LIEWrappedName RdrName-wrappedName = builtLoc . IEName . exportRdrName+wrappedName = mkLocated . IEName . exportRdrName -- | Exports an entire module. --@@ -146,4 +154,4 @@ -- > ===== -- > moduleContents "M" moduleContents :: ModuleNameStr -> IE'-moduleContents = noExt IEModuleContents . builtLoc . unModuleNameStr+moduleContents = withEpAnnNotUsed IEModuleContents . mkLocated . unModuleNameStr
src/GHC/SourceGen/Name/Internal.hs view
@@ -8,6 +8,7 @@ module GHC.SourceGen.Name.Internal where import Data.Char (isAlphaNum, isUpper)+import Data.Function (on) import Data.List (intercalate) import Data.String (IsString(..)) #if MIN_VERSION_ghc(9,0,0)@@ -15,16 +16,26 @@ import GHC.Unit.Module (mkModuleNameFS, ModuleName, moduleNameString) import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader-import GHC.Types.SrcLoc (Located) #else import FastString (FastString, fsLit) import Module (mkModuleNameFS, ModuleName, moduleNameString) import OccName import RdrName+#endif++#if MIN_VERSION_ghc(9,2,0)+import GHC.Data.FastString (LexicalFastString(..))+#endif++#if MIN_VERSION_ghc(9,2,0)+import GHC.Parser.Annotation (LocatedN)+#elif MIN_VERSION_ghc(9,0,0)+import GHC.Types.SrcLoc (Located)+#else import SrcLoc (Located) #endif -import GHC.SourceGen.Syntax.Internal (builtLoc)+import GHC.SourceGen.Syntax.Internal (mkLocated) -- | A string identifier referring to a name. --@@ -39,8 +50,17 @@ -- makes it easier to implement an 'IsString' instance without the context -- where a name would be used.) data OccNameStr = OccNameStr !RawNameSpace !FastString- deriving (Show, Eq, Ord)+ deriving (Show, Eq) +instance Ord OccNameStr where+ compare = compare `on` (\(OccNameStr n s) -> (n, fromFastString s))+ where+#if MIN_VERSION_ghc(9,2,0)+ fromFastString = LexicalFastString+#else+ fromFastString = id+#endif+ data RawNameSpace = Constructor | Value deriving (Show, Eq, Ord) @@ -90,13 +110,17 @@ data RdrNameStr = UnqualStr OccNameStr | QualStr ModuleNameStr OccNameStr deriving (Show, Eq, Ord) +#if !MIN_VERSION_ghc(9,2,0)+type LocatedN e = Located e+#endif+ -- GHC always wraps RdrName in a Located. (Usually: 'Located (IdP pass)') -- So for convenience, these functions return a Located-wrapped value.-valueRdrName, typeRdrName :: RdrNameStr -> Located RdrName-valueRdrName (UnqualStr r) = builtLoc $ Unqual $ valueOccName r-valueRdrName (QualStr (ModuleNameStr m) r) = builtLoc $ Qual m $ valueOccName r-typeRdrName (UnqualStr r) = builtLoc $ Unqual $ typeOccName r-typeRdrName (QualStr (ModuleNameStr m) r) = builtLoc $ Qual m $ typeOccName r+valueRdrName, typeRdrName :: RdrNameStr -> LocatedN RdrName+valueRdrName (UnqualStr r) = mkLocated $ Unqual $ valueOccName r+valueRdrName (QualStr (ModuleNameStr m) r) = mkLocated $ Qual m $ valueOccName r+typeRdrName (UnqualStr r) = mkLocated $ Unqual $ typeOccName r+typeRdrName (QualStr (ModuleNameStr m) r) = mkLocated $ Qual m $ typeOccName r -- TODO: operators instance IsString RdrNameStr where@@ -122,9 +146,9 @@ -- E.g.: `import F(a, B)` -- The 'a' should be a value, but the 'B' should be a type/class. -- (Currently, GHC doesn't distinguish the class and type namespaces.)-exportRdrName :: RdrNameStr -> Located RdrName-exportRdrName (UnqualStr r) = builtLoc $ Unqual $ exportOccName r-exportRdrName (QualStr (ModuleNameStr m) r) = builtLoc $ Qual m $ exportOccName r+exportRdrName :: RdrNameStr -> LocatedN RdrName+exportRdrName (UnqualStr r) = mkLocated $ Unqual $ exportOccName r+exportRdrName (QualStr (ModuleNameStr m) r) = mkLocated $ Qual m $ exportOccName r exportOccName :: OccNameStr -> OccName exportOccName (OccNameStr Value s) = mkVarOccFS s
src/GHC/SourceGen/Overloaded.hs view
@@ -36,15 +36,13 @@ #if MIN_VERSION_ghc(9,0,0) import GHC.Types.Basic (Boxity(..)) import GHC.Core.DataCon (dataConName)-import GHC.Types.Name.Reader (RdrName(..), nameRdrName)-import GHC.Types.SrcLoc (Located)+import GHC.Types.Name.Reader (nameRdrName) import GHC.Builtin.Types (consDataCon_RDR, nilDataCon, unitDataCon) import GHC.Types.Var (Specificity(..)) #else import BasicTypes (Boxity(..)) import DataCon (dataConName)-import RdrName (RdrName(..), nameRdrName)-import SrcLoc (Located)+import RdrName (nameRdrName) import TysWiredIn (consDataCon_RDR, nilDataCon, unitDataCon) #endif @@ -58,13 +56,13 @@ par :: e -> e instance Par HsExpr' where- par = noExt HsPar . builtLoc+ par = withEpAnnNotUsed HsPar . mkLocated instance Par Pat' where- par = noExt ParPat . builtPat+ par = withEpAnnNotUsed ParPat . builtPat instance Par HsType' where- par = noExt HsParTy . builtLoc+ par = withEpAnnNotUsed HsParTy . mkLocated -- | A class for term application. --@@ -129,24 +127,24 @@ instance App HsExpr' where op x o y- = noExt OpApp- (parenthesizeExprForOp $ builtLoc x)- (builtLoc $ var o)+ = withEpAnnNotUsed OpApp+ (parenthesizeExprForOp $ mkLocated x)+ (mkLocated $ var o) #if !MIN_VERSION_ghc(8,6,0) PlaceHolder #endif- (parenthesizeExprForOp $ builtLoc y)- x @@ y = noExt HsApp (parenthesizeExprForOp $ builtLoc x)- (parenthesizeExprForApp $ builtLoc y)+ (parenthesizeExprForOp $ mkLocated y)+ x @@ y = withEpAnnNotUsed HsApp (parenthesizeExprForOp $ mkLocated x)+ (parenthesizeExprForApp $ mkLocated y) instance App HsType' where op x o y- = noExt HsOpTy (parenthesizeTypeForOp $ builtLoc x)+ = noExt HsOpTy (parenthesizeTypeForOp $ mkLocated x) (typeRdrName o)- (parenthesizeTypeForOp $ builtLoc y)+ (parenthesizeTypeForOp $ mkLocated y) x @@ y = noExt HsAppTy- (parenthesizeTypeForOp $ builtLoc x)- (parenthesizeTypeForApp $ builtLoc y)+ (parenthesizeTypeForOp $ mkLocated x)+ (parenthesizeTypeForApp $ mkLocated y) class HasTuple e where unit :: e@@ -158,16 +156,22 @@ instance HasTuple HsExpr' where tupleOf b ts =- noExt ExplicitTuple- (map (builtLoc . noExt Present . builtLoc) ts)+ explicitTuple+ (map (withEpAnnNotUsed Present . mkLocated) ts) b+ where+#if MIN_VERSION_ghc(9,2,0)+ explicitTuple = withEpAnnNotUsed ExplicitTuple+#else+ explicitTuple = noExt ExplicitTuple . map builtLoc+#endif unit = noExt HsVar unitDataConName -unitDataConName :: Located RdrName-unitDataConName = builtLoc $ nameRdrName $ dataConName $ unitDataCon+unitDataConName :: LIdP+unitDataConName = mkLocated $ nameRdrName $ dataConName $ unitDataCon instance HasTuple HsType' where- tupleOf b = noExt HsTupleTy b' . map builtLoc+ tupleOf b = withEpAnnNotUsed HsTupleTy b' . map mkLocated where b' = case b of Unboxed -> HsUnboxedTuple@@ -178,7 +182,7 @@ instance HasTuple Pat' where tupleOf b ps =- noExt TuplePat (map builtPat ps) b+ withEpAnnNotUsed TuplePat (map builtPat ps) b #if !MIN_VERSION_ghc(8,6,0) [] #endif@@ -202,22 +206,28 @@ -- TODO: allow something like "consOp" which applies (:) as an operator, but using -- the built-in RdrName. -nilDataConName :: Located RdrName-nilDataConName = builtLoc $ nameRdrName $ dataConName $ nilDataCon+nilDataConName :: LIdP+nilDataConName = mkLocated $ nameRdrName $ dataConName $ nilDataCon instance HasList HsExpr' where- list = withPlaceHolder (noExt ExplicitList) Nothing . map builtLoc+ list = withPlaceHolder (withEpAnnNotUsed explicitList) . map mkLocated+ where+#if MIN_VERSION_ghc(9,2,0)+ explicitList = ExplicitList+#else+ explicitList x = ExplicitList x Nothing+#endif nil = noExt HsVar nilDataConName- cons = noExt HsVar $ builtLoc consDataCon_RDR+ cons = noExt HsVar $ mkLocated consDataCon_RDR instance HasList Pat' where #if MIN_VERSION_ghc(8,6,0)- list = noExt ListPat . map builtPat+ list = withEpAnnNotUsed ListPat . map builtPat #else list ps = ListPat (map builtPat ps) PlaceHolder Nothing #endif nil = noExt VarPat nilDataConName- cons = noExt VarPat $ builtLoc $ consDataCon_RDR+ cons = noExt VarPat $ mkLocated $ consDataCon_RDR -- | Terms that can contain references to locally-bound variables. --@@ -245,24 +255,24 @@ bvar = var . UnqualStr instance Var HsType' where- var = noExt HsTyVar notPromoted . typeRdrName+ var = withEpAnnNotUsed HsTyVar notPromoted . typeRdrName instance BVar HsType' where bvar = var . UnqualStr #if MIN_VERSION_ghc(9,0,0) instance BVar HsTyVarBndr' where- bvar = noExt UserTyVar () . typeRdrName . UnqualStr+ bvar = withEpAnnNotUsed UserTyVar () . typeRdrName . UnqualStr instance BVar HsTyVarBndrS' where- bvar = noExt UserTyVar SpecifiedSpec . typeRdrName . UnqualStr+ bvar = withEpAnnNotUsed UserTyVar SpecifiedSpec . typeRdrName . UnqualStr #else instance BVar HsTyVarBndr' where- bvar = noExt UserTyVar . typeRdrName . UnqualStr+ bvar = withEpAnnNotUsed UserTyVar . typeRdrName . UnqualStr #endif instance Var IE' where- var n = noExt IEVar $ builtLoc $ IEName $ exportRdrName n+ var n = noExt IEVar $ mkLocated $ IEName $ exportRdrName n instance BVar IE' where bvar = var . UnqualStr
src/GHC/SourceGen/Pat.hs view
@@ -26,6 +26,10 @@ import GHC.SourceGen.Syntax.Internal import GHC.SourceGen.Type.Internal (patSigType) +#if MIN_VERSION_ghc(9,2,0)+import GHC.Parser.Annotation (EpAnn(..))+#endif+ -- | A wild pattern (@_@). wildP :: Pat' wildP = noExtOrPlaceHolder WildPat@@ -36,7 +40,7 @@ -- > ===== -- > asP "a" (var "B") asP :: RdrNameStr -> Pat' -> Pat'-v `asP` p = noExt AsPat (valueRdrName v) $ builtPat $ parenthesize p+v `asP` p = withEpAnnNotUsed AsPat (valueRdrName v) $ builtPat $ parenthesize p -- | A pattern constructor. --@@ -44,14 +48,18 @@ -- > ===== -- > conP "A" [bvar "b", bvar "c"] conP :: RdrNameStr -> [Pat'] -> Pat'-conP c xs =+conP c = conPat (valueRdrName c) . prefixCon . map (builtPat . parenthesize)+ where #if MIN_VERSION_ghc(9,0,0)- noExt ConPat+ conPat = withEpAnnNotUsed ConPat #else- ConPatIn+ conPat = ConPatIn #endif- (valueRdrName c) $ PrefixCon- $ map (builtPat . parenthesize) xs+#if MIN_VERSION_ghc(9,2,0)+ prefixCon = PrefixCon []+#else+ prefixCon = PrefixCon+#endif -- | A pattern constructor with no arguments. --@@ -64,7 +72,7 @@ recordConP :: RdrNameStr -> [(RdrNameStr, Pat')] -> Pat' recordConP c fs = #if MIN_VERSION_ghc(9,0,0)- noExt ConPat+ withEpAnnNotUsed ConPat #else ConPatIn #endif@@ -73,11 +81,14 @@ where mkRecField :: (RdrNameStr, Pat') -> LHsRecField' LPat' mkRecField (f, p) =- builtLoc $ HsRecField+ mkLocated $ HsRecField { hsRecFieldLbl = builtLoc $ withPlaceHolder $ noExt FieldOcc $ valueRdrName f , hsRecFieldArg = builtPat p , hsRecPun = False+#if MIN_VERSION_ghc(9,2,0)+ , hsRecFieldAnn = EpAnnNotUsed+#endif } -- | A bang-pattern.@@ -86,7 +97,7 @@ -- > ===== -- > strictP (bvar x) strictP :: Pat' -> Pat'-strictP = noExt BangPat . builtPat . parenthesize+strictP = withEpAnnNotUsed BangPat . builtPat . parenthesize -- | A lazy pattern match. --@@ -94,7 +105,7 @@ -- > ===== -- > lazyP (conP "A" [bvar x]) lazyP :: Pat' -> Pat'-lazyP = noExt LazyPat . builtPat . parenthesize+lazyP = withEpAnnNotUsed LazyPat . builtPat . parenthesize -- | A pattern type signature --@@ -103,7 +114,7 @@ -- > sigPat (bvar "x") (var "y") sigP :: Pat' -> HsType' -> Pat' #if MIN_VERSION_ghc(8,8,0)-sigP p t = noExt SigPat (builtPat p) (patSigType t)+sigP p t = withEpAnnNotUsed SigPat (builtPat p) (patSigType t) #elif MIN_VERSION_ghc(8,6,0) sigP p t = SigPat (patSigType t) (builtPat p) #else
src/GHC/SourceGen/Pat/Internal.hs view
@@ -29,11 +29,16 @@ needsPar (LitPat l) = litNeedsParen l needsPar (NPat l _ _ _) = overLitNeedsParen $ unLoc l #endif-#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0)+needsPar (ConPat _ _ (PrefixCon _ xs)) = not $ null xs+#elif MIN_VERSION_ghc(9,0,0) needsPar (ConPat _ _ (PrefixCon xs)) = not $ null xs-needsPar (ConPat _ _ (InfixCon _ _)) = True #else needsPar (ConPatIn _ (PrefixCon xs)) = not $ null xs+#endif+#if MIN_VERSION_ghc(9,0,0)+needsPar (ConPat _ _ (InfixCon _ _)) = True+#else needsPar (ConPatIn _ (InfixCon _ _)) = True needsPar ConPatOut{} = True #endif@@ -46,5 +51,5 @@ needsPar _ = False parPat :: Pat' -> Pat'-parPat = noExt ParPat . builtPat+parPat = withEpAnnNotUsed ParPat . builtPat
src/GHC/SourceGen/Pretty.hs view
@@ -17,6 +17,10 @@ import GHC.Utils.Outputable import System.IO +#if MIN_VERSION_ghc(9,2,0)+import GHC.Driver.Ppr (printForUser, showPpr)+#endif+ hPutPpr :: Outputable a => Handle -> a -> Ghc () hPutPpr h x = do dflags <- getDynFlags
src/GHC/SourceGen/Syntax/Internal.hs view
@@ -21,6 +21,7 @@ , HsValBinds , HsMatchContext , IE+ , LHsExpr , LHsQTyVars , Match , MatchGroup@@ -28,12 +29,10 @@ , GRHSs , Stmt , ConDecl- , HsConDeclDetails , LHsSigType , ImportDecl , LHsSigWcType , LHsWcType- , HsImplicitBndrs , TyFamInstDecl #if !MIN_VERSION_ghc(8,8,0) , LHsRecField@@ -42,6 +41,11 @@ #if MIN_VERSION_ghc(9,0,0) , HsPatSigType #endif+#if MIN_VERSION_ghc(9,2,0)+ , HsConDeclH98Details+#else+ , HsConDeclDetails+#endif ) import GHC.Hs.Binds (Sig, HsLocalBinds) #if MIN_VERSION_ghc(8,6,0)@@ -58,6 +62,16 @@ import SrcLoc (SrcSpan, Located, GenLocated(..), mkGeneralSrcSpan) #endif +#if MIN_VERSION_ghc(9,2,0)+import GHC.Parser.Annotation+ ( SrcSpanAnn'(..)+ , AnnSortKey(..)+ , EpAnn(..)+ , EpAnnComments+ , emptyComments+ )+#endif+ #if MIN_VERSION_ghc(9,0,0) import GHC.Types.Basic (PromotionFlag(..)) #elif MIN_VERSION_ghc(8,8,0)@@ -67,11 +81,12 @@ #endif #if MIN_VERSION_ghc(8,10,0)-import GHC.Hs.Extension (NoExtField(NoExtField))+import qualified GHC.Hs as GHC #elif MIN_VERSION_ghc(8,6,0)-import GHC.Hs.Extension (NoExt(NoExt))+import qualified GHC.Hs.Extension as GHC #else-import PlaceHolder(PlaceHolder(..))+import qualified HsExtension as GHC+import qualified PlaceHolder as GHC #endif #if MIN_VERSION_ghc(9,0,0)@@ -80,42 +95,78 @@ import GHC.Hs.Extension (GhcPs) -#if MIN_VERSION_ghc(8,6,0) #if MIN_VERSION_ghc(8,10,0)+type NoExtField = GHC.NoExtField+#elif MIN_VERSION_ghc(8,6,0)+type NoExtField = GHC.NoExt+#endif++#if MIN_VERSION_ghc(8,10,0) noExt :: (NoExtField -> a) -> a-noExt = ($ NoExtField)+noExt = ($ GHC.NoExtField)+#elif MIN_VERSION_ghc(8,6,0)+noExt :: (NoExtField -> a) -> a+noExt = ($ GHC.NoExt)+#else+noExt :: a -> a+noExt = id+#endif +#if MIN_VERSION_ghc(8,6,0) noExtOrPlaceHolder :: (NoExtField -> a) -> a noExtOrPlaceHolder = noExt+#else+noExtOrPlaceHolder :: (GHC.PlaceHolder -> a) -> a+noExtOrPlaceHolder = withPlaceHolder+#endif +#if MIN_VERSION_ghc(9,2,0)+withEpAnnNotUsed :: (EpAnn ann -> a) -> a+withEpAnnNotUsed = ($ EpAnnNotUsed)+#elif MIN_VERSION_ghc(8,6,0)+withEpAnnNotUsed :: (NoExtField -> a) -> a+withEpAnnNotUsed = noExt #else-noExt :: (NoExt -> a) -> a-noExt = ($ NoExt)+withEpAnnNotUsed :: a -> a+withEpAnnNotUsed = id+#endif -noExtOrPlaceHolder :: (NoExt -> a) -> a-noExtOrPlaceHolder = noExt+#if MIN_VERSION_ghc(9,2,0)+withNoAnnSortKey :: (AnnSortKey -> a) -> a+withNoAnnSortKey = ($ NoAnnSortKey)+#elif MIN_VERSION_ghc(8,6,0)+withNoAnnSortKey :: (NoExtField -> a) -> a+withNoAnnSortKey = noExt+#else+withNoAnnSortKey :: a -> a+withNoAnnSortKey = id #endif +#if MIN_VERSION_ghc(9,2,0)+withEmptyEpAnnComments :: (EpAnnComments -> a) -> a+withEmptyEpAnnComments = ($ emptyComments)+#elif MIN_VERSION_ghc(8,6,0)+withEmptyEpAnnComments :: (NoExtField -> a) -> a+withEmptyEpAnnComments = noExt+#else+withEmptyEpAnnComments :: a -> a+withEmptyEpAnnComments = id+#endif++#if MIN_VERSION_ghc(8,6,0) withPlaceHolder :: a -> a withPlaceHolder = id+#else+withPlaceHolder :: (GHC.PlaceHolder -> a) -> a+withPlaceHolder = ($ GHC.PlaceHolder)+#endif +#if MIN_VERSION_ghc(8,6,0) withPlaceHolders :: a -> a withPlaceHolders = id- #else--noExt :: a -> a-noExt = id--noExtOrPlaceHolder :: (PlaceHolder -> a) -> a-noExtOrPlaceHolder = withPlaceHolder--withPlaceHolder :: (PlaceHolder -> a) -> a-withPlaceHolder = ($ PlaceHolder)--withPlaceHolders :: ([PlaceHolder] -> a) -> a+withPlaceHolders :: ([GHC.PlaceHolder] -> a) -> a withPlaceHolders = ($ [])- #endif builtSpan :: SrcSpan@@ -124,10 +175,27 @@ builtLoc :: e -> Located e builtLoc = L builtSpan +#if MIN_VERSION_ghc(9,2,0)+type SrcSpanAnn ann = GHC.SrcSpanAnn' (EpAnn ann)+#else+type SrcSpanAnn ann = SrcSpan+#endif++mkLocated :: a -> GenLocated (SrcSpanAnn ann) a+mkLocated = L (toAnn builtSpan)+ where+#if MIN_VERSION_ghc(9,2,0)+ toAnn = SrcSpanAnn EpAnnNotUsed+#else+ toAnn = id+#endif+ -- In GHC-8.8.* (but not >=8.10 or <=8.6), source locations for Pat aren't -- stored in each node, and LPat is a synonym for Pat. builtPat :: Pat' -> LPat'-#if MIN_VERSION_ghc(8,8,0) && !MIN_VERSION_ghc(8,10,0)+#if MIN_VERSION_ghc(9,2,0)+builtPat = mkLocated+#elif MIN_VERSION_ghc(8,8,0) && !MIN_VERSION_ghc(8,10,0) builtPat = id #else builtPat = builtLoc@@ -182,6 +250,8 @@ -- * 'GHC.SourceGen.Lit.HasLit' type HsExpr' = HsExpr GhcPs +type LHsExpr' = LHsExpr GhcPs+ -- | A Haskell declaration, as it is represented after the parsing step. -- -- Instances:@@ -234,11 +304,15 @@ type MatchGroup' = MatchGroup GhcPs type GRHS' = GRHS GhcPs type GRHSs' = GRHSs GhcPs-type Stmt' = Stmt GhcPs (Located HsExpr')+type Stmt' = Stmt GhcPs LHsExpr' type HsOverLit' = HsOverLit GhcPs type LHsQTyVars' = LHsQTyVars GhcPs type ConDecl' = ConDecl GhcPs+#if MIN_VERSION_ghc(9,2,0)+type HsConDeclDetails' = HsConDeclH98Details GhcPs+#else type HsConDeclDetails' = HsConDeclDetails GhcPs+#endif type LHsSigType' = LHsSigType GhcPs type ImportDecl' = ImportDecl GhcPs type LHsSigWcType' = LHsSigWcType GhcPs@@ -247,7 +321,6 @@ type LHsRecField' arg = LHsRecField GhcPs arg type LHsRecUpdField' = LHsRecUpdField GhcPs type LPat' = LPat GhcPs-type HsImplicitBndrs' = HsImplicitBndrs GhcPs type TyFamInstDecl' = TyFamInstDecl GhcPs #if MIN_VERSION_ghc(8,6,0)@@ -260,4 +333,10 @@ type HsPatSigType' = HsPatSigType GhcPs #else type HsPatSigType' = LHsSigWcType'+#endif++#if MIN_VERSION_ghc(9,2,0)+type LIdP = GHC.LIdP GHC.GhcPs+#else+type LIdP = Located (GHC.IdP GHC.GhcPs) #endif
src/GHC/SourceGen/Type.hs view
@@ -36,7 +36,7 @@ -- | A promoted name, for example from the @DataKinds@ extension. tyPromotedVar :: RdrNameStr -> HsType'-tyPromotedVar = noExt HsTyVar promoted . typeRdrName+tyPromotedVar = withEpAnnNotUsed HsTyVar promoted . typeRdrName stringTy :: String -> HsType' stringTy = noExt HsTyLit . noSourceText HsStrTy . fromString@@ -45,15 +45,15 @@ numTy = noExt HsTyLit . noSourceText HsNumTy listTy :: HsType' -> HsType'-listTy = noExt HsListTy . builtLoc+listTy = withEpAnnNotUsed HsListTy . mkLocated listPromotedTy :: [HsType'] -> HsType' -- Lists of two or more elements don't need the explicit tick (`'`). -- But for consistency, just always add it.-listPromotedTy = withPlaceHolder (noExt HsExplicitListTy promoted) . map builtLoc+listPromotedTy = withPlaceHolder (withEpAnnNotUsed HsExplicitListTy promoted) . map mkLocated tuplePromotedTy :: [HsType'] -> HsType'-tuplePromotedTy = withPlaceHolders (noExt HsExplicitTupleTy) . map builtLoc+tuplePromotedTy = withPlaceHolders (withEpAnnNotUsed HsExplicitTupleTy) . map mkLocated -- | A function type. --@@ -61,11 +61,11 @@ -- > ===== -- > var "a" --> var "b" (-->) :: HsType' -> HsType' -> HsType'-a --> b = noExt HsFunTy+a --> b = withEpAnnNotUsed HsFunTy #if MIN_VERSION_ghc(9,0,0) (HsUnrestrictedArrow NormalSyntax) #endif- (parenthesizeTypeForFun $ builtLoc a) (builtLoc b)+ (parenthesizeTypeForFun $ mkLocated a) (mkLocated b) infixr 0 --> @@ -75,16 +75,18 @@ -- > ===== -- > forall' [bvar "a"] $ var "T" @@ var "a" forall' :: [HsTyVarBndrS'] -> HsType' -> HsType'-forall' ts = noExt HsForAllTy-#if MIN_VERSION_ghc(9,0,0)- (mkHsForAllInvisTele (map builtLoc ts))+forall' ts = noExt hsForAllTy (map mkLocated ts) . mkLocated+ where+#if MIN_VERSION_ghc(9,2,0)+ hsForAllTy x = HsForAllTy x . withEpAnnNotUsed mkHsForAllInvisTele+#elif MIN_VERSION_ghc(9,0,0)+ hsForAllTy x = HsForAllTy x . mkHsForAllInvisTele+#elif MIN_VERSION_ghc(8,10,0)+ fvf = ForallInvis -- "Invisible" forall, i.e., with a dot+ hsForAllTy x = HsForAllTy x fvf #else-#if MIN_VERSION_ghc(8,10,0)- ForallInvis -- "Invisible" forall, i.e., with a dot-#endif- (map builtLoc ts)+ hsForAllTy = HsForAllTy #endif- . builtLoc -- | Qualify a type with constraints. --@@ -92,7 +94,13 @@ -- > ===== -- > [var "F" @@ var "x", var "G" @@ var "x"] ==> var "x" (==>) :: [HsType'] -> HsType' -> HsType'-(==>) cs = noExt HsQualTy (builtLoc (map builtLoc cs)) . builtLoc+(==>) cs = hsQualTy (mkLocated (map mkLocated cs)) . mkLocated+ where+#if MIN_VERSION_ghc(9,2,0)+ hsQualTy = noExt HsQualTy . Just+#else+ hsQualTy = noExt HsQualTy+#endif infixr 0 ==> @@ -102,8 +110,8 @@ -- > ===== -- > kindedVar "x" (var "A") kindedVar :: OccNameStr -> HsType' -> HsTyVarBndr'-kindedVar v t = noExt KindedTyVar+kindedVar v t = withEpAnnNotUsed KindedTyVar #if MIN_VERSION_ghc(9,0,0) () #endif- (typeRdrName $ UnqualStr v) (builtLoc t)+ (typeRdrName $ UnqualStr v) (mkLocated t)
src/GHC/SourceGen/Type/Internal.hs view
@@ -7,12 +7,14 @@ {-# LANGUAGE CPP #-} module GHC.SourceGen.Type.Internal where +import GHC.Hs (GhcPs)+ #if MIN_VERSION_ghc(9,0,0) import GHC.Hs.Type as Types-import GHC.Types.SrcLoc (Located, unLoc)+import GHC.Types.SrcLoc (unLoc) #else import GHC.Hs.Type as Types-import SrcLoc (Located, unLoc)+import SrcLoc (unLoc) #endif import GHC.SourceGen.Syntax.Internal@@ -20,13 +22,14 @@ mkQTyVars :: [HsTyVarBndr'] -> LHsQTyVars' mkQTyVars vars = withPlaceHolder $ noExt (withPlaceHolder HsQTvs)- $ map builtLoc vars+ $ map mkLocated vars sigType :: HsType' -> LHsSigType'-sigType = implicitBndrs . builtLoc--implicitBndrs :: t -> HsImplicitBndrs' t-implicitBndrs = withPlaceHolder . noExt (withPlaceHolder Types.HsIB)+#if MIN_VERSION_ghc(9,2,0)+sigType = mkLocated . noExt HsSig (noExt HsOuterImplicit) . mkLocated+#else+sigType = withPlaceHolder . noExt (withPlaceHolder Types.HsIB) . builtLoc+#endif -- TODO: GHC >= 8.6 provides parenthesizeHsType. For consistency with@@ -34,7 +37,7 @@ -- Once we stop supporting GHC-8.4, we can switch to that implementation. parenthesizeTypeForApp, parenthesizeTypeForOp, parenthesizeTypeForFun- :: Located HsType' -> Located HsType'+ :: LHsType GhcPs -> LHsType GhcPs parenthesizeTypeForApp t | needsParenForApp (unLoc t) = parTy t | otherwise = t@@ -59,17 +62,19 @@ HsAppTy {} -> True _ -> needsParenForOp t -parTy :: Located HsType' -> Located HsType'-parTy = builtLoc . noExt HsParTy+parTy :: LHsType GhcPs -> LHsType GhcPs+parTy = mkLocated . withEpAnnNotUsed HsParTy sigWcType :: HsType' -> LHsSigWcType' sigWcType = noExt (withPlaceHolder Types.HsWC) . sigType wcType :: HsType' -> LHsWcType'-wcType = noExt (withPlaceHolder Types.HsWC) . builtLoc+wcType = noExt (withPlaceHolder Types.HsWC) . mkLocated patSigType :: HsType' -> HsPatSigType'-#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(9,2,0)+patSigType = withEpAnnNotUsed mkHsPatSigType . mkLocated+#elif MIN_VERSION_ghc(9,0,0) patSigType = mkHsPatSigType . builtLoc #else patSigType = sigWcType