ghc-source-gen 0.3.0.0 → 0.4.0.0

raw patch · 27 files changed

+319/−177 lines, 27 filesdep ~ghcnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc

API changes (from Hackage documentation)

Files

• ChangeLog.md +16/−0
• compat/GHC/Hs.hs +2/−0
• compat/GHC/Hs/Binds.hs +2/−0
• compat/GHC/Hs/Decls.hs +2/−0
• compat/GHC/Hs/Expr.hs +2/−0
• compat/GHC/Hs/Extension.hs +2/−0
• compat/GHC/Hs/ImpExp.hs +2/−0
• compat/GHC/Hs/Lit.hs +2/−0
• compat/GHC/Hs/Pat.hs +2/−0
• compat/GHC/Hs/Types.hs +2/−0
• ghc-source-gen.cabal +20/−7
• src/GHC/SourceGen/Binds.hs +3/−3
• src/GHC/SourceGen/Binds/Internal.hs +3/−8
• src/GHC/SourceGen/Decl.hs +23/−30
• src/GHC/SourceGen/Expr.hs +64/−3
• src/GHC/SourceGen/Expr/Internal.hs +1/−1
• src/GHC/SourceGen/Lit.hs +3/−14
• src/GHC/SourceGen/Lit/Internal.hs +1/−9
• src/GHC/SourceGen/Module.hs +25/−4
• src/GHC/SourceGen/Overloaded.hs +3/−3
• src/GHC/SourceGen/Pat.hs +3/−3
• src/GHC/SourceGen/Pat/Internal.hs +2/−2
• src/GHC/SourceGen/Syntax/Internal.hs +32/−69
• src/GHC/SourceGen/Type.hs +21/−2
• src/GHC/SourceGen/Type/Internal.hs +6/−8
• tests/pprint_examples.hs +8/−8
• tests/pprint_test.hs +67/−3

@@ -1,5 +1,21 @@ # Changelog for haskell-syntax +# 0.4.0.0++## Breaking Changes+- Functions defining types and classes now take their+  type parameters as `HsTyVarBndr'` rather than `OccNameStr`.+  To construct a `HsTyVarBndr'`, use either `bvar` or `kindedVar`.+  Affects: `class'`, `type'`, `newtype'`, and `data'`.+- Remove support for ghc-8.2.*.++## Other Changes+- Add support for ghc-8.10.+- Add `kindedVar`.+- Add `tuplePromotedTy`.+- Add `from`, `fromTo`, `fromThen`, `fromThenTo`.+- Add `listComp`.+ ## 0.3.0.0 - Add `occNameToStr` and `nameToStr` to convert from the GHC types. - Make `listPromotedTy` emit the promoted form `'[..]`,

@@ -0,0 +1,2 @@+module GHC.Hs (module HsSyn) where+import HsSyn

@@ -0,0 +1,2 @@+module GHC.Hs.Binds (module HsBinds) where+import HsBinds

@@ -0,0 +1,2 @@+module GHC.Hs.Decls (module HsDecls) where+import HsDecls

@@ -0,0 +1,2 @@+module GHC.Hs.Expr (module HsExpr) where+import HsExpr

@@ -0,0 +1,2 @@+module GHC.Hs.Extension (module HsExtension) where+import HsExtension

@@ -0,0 +1,2 @@+module GHC.Hs.ImpExp (module HsImpExp) where+import HsImpExp

@@ -0,0 +1,2 @@+module GHC.Hs.Lit (module HsLit) where+import HsLit

@@ -0,0 +1,2 @@+module GHC.Hs.Pat (module HsPat) where+import HsPat

@@ -0,0 +1,2 @@+module GHC.Hs.Types (module HsTypes) where+import HsTypes

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: df3442cc801aef91cf974539ddc9628924856c16db7eaddc3ca0811136afa6e2+-- hash: 5ce0ceef64535fb124b604d3193e37b6dc89ea437af2ac6cbe6c631afad662ed  name:           ghc-source-gen-version:        0.3.0.0+version:        0.4.0.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@@ -60,7 +60,20 @@   default-extensions: DataKinds FlexibleInstances TypeSynonymInstances   build-depends:       base >=4.7 && <5-    , ghc >=8.2 && <8.9+    , ghc >=8.4 && <8.11+  if impl(ghc<8.10)+    other-modules:+        GHC.Hs+        GHC.Hs.Binds+        GHC.Hs.Decls+        GHC.Hs.Expr+        GHC.Hs.Extension+        GHC.Hs.ImpExp+        GHC.Hs.Lit+        GHC.Hs.Pat+        GHC.Hs.Types+    hs-source-dirs:+        compat   default-language: Haskell2010  test-suite name_test@@ -75,7 +88,7 @@   build-depends:       QuickCheck >=2.10 && <2.14     , base >=4.7 && <5-    , ghc >=8.2 && <8.9+    , ghc >=8.4 && <8.11     , ghc-source-gen     , tasty >=1.0 && <1.3     , tasty-hunit ==0.10.*@@ -93,7 +106,7 @@   default-extensions: DataKinds FlexibleInstances TypeSynonymInstances   build-depends:       base >=4.7 && <5-    , ghc >=8.2 && <8.9+    , ghc >=8.4 && <8.11     , ghc-paths ==0.1.*     , ghc-source-gen     , tasty >=1.0 && <1.3@@ -111,7 +124,7 @@   default-extensions: DataKinds FlexibleInstances TypeSynonymInstances   build-depends:       base >=4.7 && <5-    , ghc >=8.2 && <8.9+    , ghc >=8.4 && <8.11     , ghc-paths ==0.1.*     , ghc-source-gen     , tasty >=1.0 && <1.3

@@ -45,9 +45,9 @@     ) where  import BasicTypes (LexicalFixity(..))-import HsBinds-import HsExpr-import HsTypes+import GHC.Hs.Binds+import GHC.Hs.Expr+import GHC.Hs.Types import TcEvidence (HsWrapper(WpHole))  import GHC.SourceGen.Binds.Internal

@@ -9,9 +9,9 @@  import BasicTypes (Origin(Generated)) import Bag (listToBag)-import HsBinds-import HsDecls-import HsExpr (MatchGroup(..), Match(..), GRHSs(..))+import GHC.Hs.Binds+import GHC.Hs.Decls+import GHC.Hs.Expr (MatchGroup(..), Match(..), GRHSs(..)) import SrcLoc (Located)  #if !MIN_VERSION_ghc(8,6,0)@@ -88,11 +88,6 @@     mkMatch :: RawMatch -> Match' (Located HsExpr')     mkMatch r = noExt Match context                     (map builtPat $ map parenthesize $ rawMatchPats r)-#if !MIN_VERSION_ghc(8,4,0)-                    -- The GHC docs say: "A type signature for the result of the match."-                    -- The parsing step produces 'Nothing' for this field.-                    Nothing-#endif                     (mkGRHSs $ rawMatchGRHSs r)  mkGRHSs :: RawGRHSs -> GRHSs' (Located HsExpr')

@@ -50,9 +50,9 @@ import BasicTypes (DerivStrategy(..)) #endif import Bag (listToBag)-import HsBinds-import HsDecls-import HsTypes+import GHC.Hs.Binds+import GHC.Hs.Decls+import GHC.Hs.Types     ( ConDeclField(..)     , FieldOcc(..)     , HsConDetails(..)@@ -66,8 +66,10 @@     ) import SrcLoc (Located) -#if MIN_VERSION_ghc(8,6,0)-import HsExtension (NoExt(NoExt))+#if 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)) #else import PlaceHolder (PlaceHolder(..)) #endif@@ -128,7 +130,7 @@ -- > in class' -- >      [var "Real" @@ a, var "Enum" @@ a] -- >      "Integral"--- >      ["a"]+-- >      [bvar "a"] -- >      [ typeSig "divMod" $ a --> a --> tuple [a, a] -- >      , typeSig "div" $ a --> a --> a -- >      , funBind "div"@@ -138,13 +140,15 @@ class'     :: [HsType'] -- ^ Context     -> OccNameStr -- ^ Class name-    -> [OccNameStr] -- ^ Type parameters+    -> [HsTyVarBndr'] -- ^ Type parameters     -> [ClassDecl] -- ^ Class declarations     -> HsDecl' class' context name vars decls     = noExt TyClD $ ClassDecl             { tcdCtxt = builtLoc $ map builtLoc context-#if MIN_VERSION_ghc(8,6,0)+#if MIN_VERSION_ghc(8,10,0)+            , tcdCExt = NoExtField+#elif MIN_VERSION_ghc(8,6,0)             , tcdCExt = NoExt #else             , tcdFVs = PlaceHolder@@ -193,7 +197,9 @@ instance' :: HsType' -> [RawInstDecl] -> HsDecl' instance' ty decls = noExt InstD  $ noExt ClsInstD $ ClsInstDecl     { cid_poly_ty = sigType ty-#if MIN_VERSION_ghc(8,6,0)+#if 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]@@ -222,7 +228,6 @@ -- > tyFamInst "Elt" [var "String"] (var "Char") tyFamInst :: HasTyFamInst t => RdrNameStr -> [HsType'] -> HsType' -> t tyFamInst name params ty = tyFamInstD-#if MIN_VERSION_ghc(8,4,0)         $ TyFamInstDecl         $ implicitBndrs         $ noExt FamEqn (typeRdrName name)@@ -234,20 +239,13 @@ #endif             Prefix             (builtLoc ty)-#else-        $ withPlaceHolder $ TyFamInstDecl-        $ builtLoc $ TyFamEqn (typeRdrName name)-                        (implicitBndrs $ map builtLoc params)-                        Prefix-                        (builtLoc ty)-#endif  -- | Declares a type synonym. -- -- > type A a b = B b a -- > =====--- > type' "A" ["a", "b"] $ var "B" @@ var "b" @@ var "a"-type' :: OccNameStr -> [OccNameStr] -> HsType' -> HsDecl'+-- > 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)         (mkQTyVars vars)@@ -257,7 +255,7 @@ newOrDataType     :: NewOrData     -> OccNameStr-    -> [OccNameStr]+    -> [HsTyVarBndr']     -> [ConDecl']     -> [HsDerivingClause']     -> HsDecl'@@ -276,10 +274,10 @@ -- -- > newtype Const a b = Const a deriving Eq -- > =====--- > newtype' "Const" ["a", "b"]+-- > newtype' "Const" [bvar "a", bvar "b"] -- >    (conDecl "Const" [var "a"]) -- >    [var "Show"]-newtype' :: OccNameStr -> [OccNameStr] -> ConDecl' -> [HsDerivingClause'] -> HsDecl'+newtype' :: OccNameStr -> [HsTyVarBndr'] -> ConDecl' -> [HsDerivingClause'] -> HsDecl' newtype' name vars conD = newOrDataType NewType name vars [conD]  -- | A data declaration.@@ -287,12 +285,12 @@ -- > data Either a b = Left a | Right b -- >    deriving Show -- > =====--- > data' "Either" ["a", "b"]+-- > data' "Either" [bvar "a", bvar "b"] -- >   [ conDecl "Left" [var "a"] -- >   , conDecl "Right" [var "b"] -- >   ] -- >   [var "Show"]-data' :: OccNameStr -> [OccNameStr] -> [ConDecl'] -> [HsDerivingClause'] -> HsDecl'+data' :: OccNameStr -> [HsTyVarBndr'] -> [ConDecl'] -> [HsDerivingClause'] -> HsDecl' data' = newOrDataType DataType  -- | Declares a Haskell-98-style prefix constructor for a data or type@@ -441,12 +439,7 @@ patSynBind :: OccNameStr -> [OccNameStr] -> Pat' -> HsDecl' patSynBind n ns p = bindB $ noExt PatSynBind                     $ withPlaceHolder (noExt PSB (valueRdrName $ unqual n))-#if MIN_VERSION_ghc(8,4,0)-                        (PrefixCon-#else-                        (PrefixPatSyn-#endif-                            (map (valueRdrName . unqual) ns))+                        (PrefixCon (map (valueRdrName . unqual) ns))                         (builtPat p)                         ImplicitBidirectional 

@@ -16,16 +16,22 @@     , if'     , multiIf     , do'+    , listComp     , Stmt'     , (@::@)     , tyApp     , recordConE     , recordUpd+    , from+    , fromThen+    , fromTo+    , fromThenTo     ) where -import HsExpr-import HsPat (HsRecField'(..), HsRecFields(..))-import HsTypes (FieldOcc(..), AmbiguousFieldOcc(..))+import GHC.Hs.Expr+import GHC.Hs.Extension (GhcPs)+import GHC.Hs.Pat (HsRecField'(..), HsRecFields(..))+import GHC.Hs.Types (FieldOcc(..), AmbiguousFieldOcc(..)) import Data.String (fromString) import SrcLoc (unLoc, GenLocated(..), Located) @@ -104,6 +110,20 @@ #endif     parenthesizeIfLet s = s +-- | A list comprehension expression.+--+-- > [x * 2 | x <- [1 .. 10], even x]+-- > =====+-- > listComp (op (bvar "x") "*" (int 2))+-- >          [ bvar "x" <-- fromTo (int 1) (int 10)+-- >          , stmt $ var "even" @@ bvar "x"+-- >          ]+listComp :: HsExpr' -> [Stmt'] -> HsExpr'+listComp lastExpr stmts =+    let lastStmt = noExt LastStmt (builtLoc lastExpr) False noSyntaxExpr+     in withPlaceHolder . noExt HsDo ListComp . builtLoc . map builtLoc $+            stmts ++ [lastStmt]+ -- | A type constraint on an expression. -- -- > e :: t@@ -187,3 +207,44 @@             }     withPlaceHolder4 = withPlaceHolder . withPlaceHolder . withPlaceHolder                             . withPlaceHolder++arithSeq :: ArithSeqInfo GhcPs -> HsExpr'+arithSeq =+#if !MIN_VERSION_ghc(8,6,0)+    ArithSeq noPostTcExpr Nothing+#else+    noExt ArithSeq Nothing+#endif++-- | An arithmetic sequence expression with a start value.+--+-- > [a ..]+-- > =====+-- > from (var "a")+from :: HsExpr' -> HsExpr'+from from' = arithSeq $ From (builtLoc from')++-- | An arithmetic sequence expression with a start and a step values.+--+-- > [a, b ..]+-- > =====+-- > fromThen (var "a") (var "b")+fromThen :: HsExpr' -> HsExpr' -> HsExpr'+fromThen from' then' = arithSeq $ FromThen (builtLoc from') (builtLoc then')++-- | An arithmetic sequence expression with a start and an end values.+--+-- > [a .. b]+-- > =====+-- > fromTo (var "a") (var "b")+fromTo :: HsExpr' -> HsExpr' -> HsExpr'+fromTo from' to = arithSeq $ FromTo (builtLoc from') (builtLoc to)++-- | An arithmetic sequence expression with a start, a step, and an end values.+--+-- > [a, b .. c]+-- > =====+-- > fromThenTo (var "a") (var "b") (var "c")+fromThenTo :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'+fromThenTo from' then' to =+    arithSeq $ FromThenTo (builtLoc from') (builtLoc then') (builtLoc to)

@@ -7,7 +7,7 @@ {-# LANGUAGE CPP #-} module GHC.SourceGen.Expr.Internal where -import HsExpr+import GHC.Hs.Expr import SrcLoc (Located, unLoc)  import GHC.SourceGen.Lit.Internal

@@ -4,7 +4,6 @@ -- license that can be found in the LICENSE file or at -- https://developers.google.com/open-source/licenses/bsd -{-# LANGUAGE CPP #-} -- | This module provides combinators for constructing Haskell literals, -- which may be used in either patterns or expressions. module GHC.SourceGen.Lit@@ -18,12 +17,10 @@     ) where  import BasicTypes (FractionalLit(..))-#if MIN_VERSION_ghc(8,4,0) import BasicTypes(IntegralLit(..), SourceText(..))-#endif-import HsLit-import HsExpr (noExpr, noSyntaxExpr, HsExpr(..))-import HsPat (Pat(..))+import GHC.Hs.Lit+import GHC.Hs.Expr (noExpr, noSyntaxExpr, HsExpr(..))+import GHC.Hs.Pat (Pat(..)) import FastString (fsLit)  import GHC.SourceGen.Lit.Internal@@ -52,19 +49,11 @@ int :: HasLit e => Integer -> e int n = overLit $ withPlaceHolder $ withPlaceHolder (noExt OverLit il) noExpr   where-#if MIN_VERSION_ghc(8,4,0)     il = HsIntegral $ noSourceText IL (n < 0) n-#else-    il = noSourceText HsIntegral n-#endif  -- | 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   where-#if MIN_VERSION_ghc(8,4,0)     il = FL (SourceText s) (x < 0) x-#else-    il = FL s x-#endif     s = show (fromRational x :: Double)

@@ -4,14 +4,11 @@ -- license that can be found in the LICENSE file or at -- https://developers.google.com/open-source/licenses/bsd -{-# LANGUAGE CPP #-} module GHC.SourceGen.Lit.Internal where  import BasicTypes (SourceText(NoSourceText), FractionalLit(..))-#if MIN_VERSION_ghc(8,4,0) import BasicTypes (IntegralLit(..))-#endif-import HsLit+import GHC.Hs.Lit import GHC.SourceGen.Syntax.Internal  noSourceText :: (SourceText -> a) -> a@@ -26,11 +23,6 @@ overLitNeedsParen :: HsOverLit' -> Bool overLitNeedsParen = needs . ol_val   where-#if MIN_VERSION_ghc(8,4,0)     needs (HsIntegral x) = il_neg x     needs (HsFractional x) = fl_neg x-#else-    needs (HsIntegral _ x) = x < 0-    needs (HsFractional x) = fl_value x < 0-#endif     needs _ = False

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- Copyright 2019 Google LLC -- -- Use of this source code is governed by a BSD-style@@ -17,6 +18,7 @@     , import'     , exposing     , hiding+    , source       -- * Imported/exported things     , IE'     , thingAll@@ -24,10 +26,13 @@     , moduleContents     )  where -import HsImpExp (LIEWrappedName, IEWildcard(..), IEWrappedName(..), IE(..))-import HsSyn+import GHC.Hs.ImpExp (LIEWrappedName, IEWildcard(..), IEWrappedName(..), IE(..))+import GHC.Hs     ( HsModule(..)     , ImportDecl(..)+#if MIN_VERSION_ghc(8,10,0)+    , ImportDeclQualifiedStyle(..)+#endif     ) import RdrName (RdrName) @@ -52,7 +57,13 @@     }  qualified' :: ImportDecl' -> ImportDecl'-qualified' d = d { ideclQualified = True }+qualified' d = d { ideclQualified =+#if MIN_VERSION_ghc(8,10,0)+    QualifiedPre+#else+    True+#endif+}  as' :: ImportDecl' -> ModuleNameStr -> ImportDecl' as' d m = d { ideclAs = Just (builtLoc $ unModuleNameStr m) }@@ -60,7 +71,13 @@ import' :: ModuleNameStr -> ImportDecl' import' m = noSourceText (noExt ImportDecl)             (builtLoc $ unModuleNameStr m)-            Nothing False False False False Nothing Nothing+            Nothing False False+#if MIN_VERSION_ghc(8,10,0)+            NotQualified+#else+            False+#endif+            False Nothing Nothing  exposing :: ImportDecl' -> [IE'] -> ImportDecl' exposing d ies = d@@ -69,6 +86,10 @@ hiding :: ImportDecl' -> [IE'] -> ImportDecl' hiding d ies = d     { ideclHiding = Just (True, builtLoc $ map builtLoc ies) }++-- | Adds the @{-# SOURCE #-}@ pragma to an import.+source :: ImportDecl' -> ImportDecl'+source d = d { ideclSource = True }  -- | Exports all methods and/or constructors. --

@@ -19,16 +19,16 @@     ) where  import BasicTypes (Boxity(..))-import HsTypes+import GHC.Hs.Types     ( HsType(..)     , HsTyVarBndr(..)     )-import HsSyn (IE(..), IEWrappedName(..))+import GHC.Hs (IE(..), IEWrappedName(..)) #if !MIN_VERSION_ghc(8,6,0) import PlaceHolder(PlaceHolder(..)) #endif -import HsSyn+import GHC.Hs     ( HsExpr(..)     , Pat(..)     , HsTupArg(..)

@@ -18,8 +18,8 @@     , sigP     ) where -import HsTypes-import HsPat hiding (LHsRecField')+import GHC.Hs.Types+import GHC.Hs.Pat hiding (LHsRecField')  import GHC.SourceGen.Name.Internal import GHC.SourceGen.Pat.Internal@@ -92,7 +92,7 @@ -- > sigPat (bvar "x") (var "y") sigP :: Pat' -> HsType' -> Pat' #if MIN_VERSION_ghc(8,8,0)-sigP p t = noExt SigPat p (sigWcType t)+sigP p t = noExt SigPat (builtPat p) (sigWcType t) #elif MIN_VERSION_ghc(8,6,0) sigP p t = SigPat (sigWcType t) (builtPat p) #else

@@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} module GHC.SourceGen.Pat.Internal where -import HsPat (Pat(..))-import HsTypes (HsConDetails(..))+import GHC.Hs.Pat (Pat(..))+import GHC.Hs.Types (HsConDetails(..))  import GHC.SourceGen.Lit.Internal (litNeedsParen, overLitNeedsParen) import GHC.SourceGen.Syntax.Internal

@@ -9,7 +9,7 @@ module GHC.SourceGen.Syntax.Internal where  -import HsSyn+import GHC.Hs     ( HsDecl     , HsExpr(..)     , HsLit@@ -40,43 +40,55 @@     , LHsRecUpdField #endif     )-import HsBinds (Sig, HsLocalBinds)+import GHC.Hs.Binds (Sig, HsLocalBinds) #if MIN_VERSION_ghc(8,6,0)-import HsDecls (DerivStrategy)+import GHC.Hs.Decls (DerivStrategy) #else import BasicTypes (DerivStrategy) #endif-import HsDecls (HsDerivingClause)-import HsPat+import GHC.Hs.Decls (HsDerivingClause)+import GHC.Hs.Pat import RdrName (RdrName) import SrcLoc (SrcSpan, Located, GenLocated(..), mkGeneralSrcSpan)  #if MIN_VERSION_ghc(8,8,0) import BasicTypes (PromotionFlag(..)) #else-import HsTypes (Promoted(..))+import GHC.Hs.Types (Promoted(..)) #endif -#if MIN_VERSION_ghc(8,6,0)-import HsExtension (NoExt(NoExt))+#if 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)) #else import PlaceHolder(PlaceHolder(..)) #endif -#if MIN_VERSION_ghc(8,4,0)-import HsExtension (GhcPs)-#endif+import GHC.Hs.Extension (GhcPs)  #if MIN_VERSION_ghc(8,6,0)+#if MIN_VERSION_ghc(8,10,0)+noExt :: (NoExtField -> a) -> a+noExt = ($ NoExtField)++noExtOrPlaceHolder :: (NoExtField -> a) -> a+noExtOrPlaceHolder = noExt++#else noExt :: (NoExt -> a) -> a noExt = ($ NoExt)  noExtOrPlaceHolder :: (NoExt -> a) -> a noExtOrPlaceHolder = noExt+#endif  withPlaceHolder :: a -> a withPlaceHolder = id +withPlaceHolders :: a -> a+withPlaceHolders = id+ #else  noExt :: a -> a@@ -88,6 +100,9 @@ withPlaceHolder :: (PlaceHolder -> a) -> a withPlaceHolder = ($ PlaceHolder) +withPlaceHolders :: ([PlaceHolder] -> a) -> a+withPlaceHolders = ($ [])+ #endif  builtSpan :: SrcSpan@@ -96,10 +111,10 @@ builtLoc :: e -> Located e builtLoc = L builtSpan --- In GHC-8.8, source locations for Pat aren't stored in each node, and--- LPat is a synonym for Pat.+-- 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)+#if MIN_VERSION_ghc(8,8,0) && !MIN_VERSION_ghc(8,10,0) builtPat = id #else builtPat = builtLoc@@ -128,11 +143,7 @@ -- * 'GHC.SourceGen.Overloaded.Par' -- * 'GHC.SourceGen.Overloaded.App' -- * 'GHC.SourceGen.Overloaded.HasTuple'-#if MIN_VERSION_ghc(8,4,0) type HsType' = HsType GhcPs-#else-type HsType' = HsType RdrName-#endif  -- | A Haskell pattern, as it is represented after the parsing step. --@@ -143,11 +154,7 @@ -- * 'GHC.SourceGen.Overloaded.HasTuple' -- * 'GHC.SourceGen.Overloaded.HasList' -- * 'GHC.SourceGen.Lit.HasLit'-#if MIN_VERSION_ghc(8,4,0) type Pat' = Pat GhcPs-#else-type Pat' = Pat RdrName-#endif  -- | A Haskell expression, as it is represented after the parsing step. --@@ -160,11 +167,7 @@ -- * 'GHC.SourceGen.Overloaded.HasTuple' -- * 'GHC.SourceGen.Overloaded.HasList' -- * 'GHC.SourceGen.Lit.HasLit'-#if MIN_VERSION_ghc(8,4,0) type HsExpr' = HsExpr GhcPs-#else-type HsExpr' = HsExpr RdrName-#endif  -- | A Haskell declaration, as it is represented after the parsing step. --@@ -172,11 +175,7 @@ -- -- * 'GHC.SourceGen.Binds.HasValBind' -- * 'GHC.SourceGen.Binds.HasPatBind'-#if MIN_VERSION_ghc(8,4,0) type HsDecl' = HsDecl GhcPs-#else-type HsDecl' = HsDecl RdrName-#endif  -- | An imported or exported entity, as it is represented after the parsing step. --@@ -184,25 +183,19 @@ -- -- * 'GHC.SourceGen.Overloaded.BVar' -- * 'GHC.SourceGen.Overloaded.Var'-#if MIN_VERSION_ghc(8,4,0) type IE' = IE GhcPs-#else-type IE' = IE RdrName-#endif   -- | A type variable binding, as it is represented after the parsing step. --+-- Construct with either 'GHC.SourceGen.Overloaded.bVar' (for regular type+-- variables) or `GHC.SourceGen.Type.kindedVar` (for kind signatures).+-- -- Instances: -- -- * 'GHC.SourceGen.Overloaded.BVar'-#if MIN_VERSION_ghc(8,4,0) type HsTyVarBndr' = HsTyVarBndr GhcPs-#else-type HsTyVarBndr' = HsTyVarBndr RdrName-#endif -#if MIN_VERSION_ghc(8,4,0) type HsLit' = HsLit GhcPs type HsModule' = HsModule GhcPs type HsBind' = HsBind GhcPs@@ -229,36 +222,6 @@ type LPat' = LPat GhcPs type HsImplicitBndrs' = HsImplicitBndrs GhcPs type TyFamInstDecl' = TyFamInstDecl GhcPs--#else-type HsLit' = HsLit-type HsModule' = HsModule RdrName-type HsBind' = HsBind RdrName-type HsLocalBinds' = HsLocalBinds RdrName-type HsValBinds' = HsValBinds RdrName-type Sig' = Sig RdrName-type HsMatchContext' = HsMatchContext RdrName-type Match' = Match RdrName-type MatchGroup' = MatchGroup RdrName-type GRHS' = GRHS RdrName-type GRHSs' = GRHSs RdrName-type Stmt' = Stmt RdrName (Located HsExpr')-type HsOverLit' = HsOverLit RdrName-type LHsQTyVars' = LHsQTyVars RdrName-type ConDecl' = ConDecl RdrName-type HsConDeclDetails' = HsConDeclDetails RdrName-type LHsSigType' = LHsSigType RdrName-type ImportDecl' = ImportDecl RdrName-type LHsSigWcType' = LHsSigWcType RdrName-type LHsWcType' = LHsWcType RdrName-type HsDerivingClause' = HsDerivingClause RdrName-type LHsRecField' arg = LHsRecField RdrName arg-type LHsRecUpdField' = LHsRecUpdField RdrName-type LPat' = LPat RdrName-type HsImplicitBndrs' = HsImplicitBndrs RdrName-type TyFamInstDecl' = TyFamInstDecl RdrName--#endif  #if MIN_VERSION_ghc(8,6,0) type DerivStrategy' = DerivStrategy GhcPs

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- Copyright 2019 Google LLC -- -- Use of this source code is governed by a BSD-style@@ -12,14 +13,16 @@     , numTy     , listTy     , listPromotedTy+    , tuplePromotedTy     , (-->)     , forall'     , HsTyVarBndr'     , (==>)+    , kindedVar     ) where  import Data.String (fromString)-import HsTypes+import GHC.Hs.Types  import GHC.SourceGen.Syntax.Internal import GHC.SourceGen.Lit.Internal (noSourceText)@@ -44,6 +47,9 @@ -- But for consistency, just always add it. listPromotedTy = withPlaceHolder (noExt HsExplicitListTy promoted) . map builtLoc +tuplePromotedTy :: [HsType'] -> HsType'+tuplePromotedTy = withPlaceHolders (noExt HsExplicitTupleTy) . map builtLoc+ -- | A function type. -- -- > a -> b@@ -60,7 +66,11 @@ -- > ===== -- > forall' [bvar "a"] $ var "T" @@ var "a" forall' :: [HsTyVarBndr'] -> HsType' -> HsType'-forall' ts = noExt HsForAllTy (map builtLoc ts) . builtLoc+forall' ts = noExt HsForAllTy+#if MIN_VERSION_ghc(8,10,0)+        ForallInvis  -- "Invisible" forall, i.e., with a dot+#endif+        (map builtLoc ts) . builtLoc  -- | Qualify a type with constraints. --@@ -71,3 +81,12 @@ (==>) cs = noExt HsQualTy (builtLoc (map builtLoc cs)) . builtLoc  infixr 0 ==>++-- | A type variable with a kind signature.+--+-- > x :: A+-- > =====+-- > kindedVar "x" (var "A")+kindedVar :: OccNameStr -> HsType' -> HsTyVarBndr'+kindedVar v t = noExt KindedTyVar (typeRdrName $  UnqualStr v)+                        (builtLoc t)

@@ -7,23 +7,21 @@ {-# LANGUAGE CPP #-} module GHC.SourceGen.Type.Internal where -import HsTypes+import GHC.Hs.Types as Types import SrcLoc (Located, unLoc)  import GHC.SourceGen.Syntax.Internal-import GHC.SourceGen.Name.Internal -mkQTyVars :: [OccNameStr] -> LHsQTyVars'+mkQTyVars :: [HsTyVarBndr'] -> LHsQTyVars' mkQTyVars vars =  withPlaceHolder                 $ noExt (withPlaceHolder HsQTvs)-                $ map (builtLoc . noExt UserTyVar . typeRdrName . UnqualStr)-                    vars+                $ map builtLoc vars  sigType :: HsType' -> LHsSigType' sigType = implicitBndrs . builtLoc  implicitBndrs :: t -> HsImplicitBndrs' t-implicitBndrs = withPlaceHolder . noExt (withPlaceHolder HsTypes.HsIB)+implicitBndrs = withPlaceHolder . noExt (withPlaceHolder Types.HsIB)   -- TODO: GHC >= 8.6 provides parenthesizeHsType.  For consistency with@@ -60,7 +58,7 @@ parTy = builtLoc . noExt HsParTy  sigWcType :: HsType' -> LHsSigWcType'-sigWcType = noExt (withPlaceHolder HsTypes.HsWC) . sigType+sigWcType = noExt (withPlaceHolder Types.HsWC) . sigType  wcType :: HsType' -> LHsWcType'-wcType = noExt (withPlaceHolder HsTypes.HsWC) . builtLoc+wcType = noExt (withPlaceHolder Types.HsWC) . builtLoc

@@ -116,26 +116,26 @@     , typeSig "g" $ op (var "A" @@ var "x") "*"                         (op (var "B" @@ var "y") "+"                                  (var "C" @@ var "z"))-    , class' [var "A" @@ var "a"] "B" ["b", "b'"]+    , class' [var "A" @@ var "a"] "B" [bvar "b", bvar "b'"]         [ typeSig "f" $ var "b" --> var "b'"         , funBind "f" $ match [] $ var "id"         ]-    , class' [] "F" ["a", "b", "c"]+    , class' [] "F" [bvar "a", bvar "b", bvar "c"]         [ funDep ["a", "b"] ["c"]         , funDep ["a"] ["b", "c"]         ]-    , class' [] "Ident" ["a", "b"]+    , class' [] "Ident" [bvar "a", bvar "b"]         [ funDep ["a"] ["b"]         , funDep ["b"] ["a"]         , typeSig "ident" $ var "a" --> var "b"         ]-    , type' "A" ["b", "c"] $ var "D"-    , data' "A" ["b", "c"]+    , type' "A" [bvar "b", bvar "c"] $ var "D"+    , data' "A" [bvar "b", bvar "c"]         [ prefixCon "A" [field (var "b"), field (var "c")]         , prefixCon "D" []         ]         [deriving' [var "X", var "Y"]]-    , newtype' "A" ["b", "c"] (prefixCon "A" [field (var "b")])+    , newtype' "A" [bvar "b", bvar "c"] (prefixCon "A" [field (var "b")])         [deriving' [var "X", var "Y"]]     , instance' (var "A" @@ var "b" @@ var "c")         [ typeSig "f" $ var "b" --> var "c"@@ -145,7 +145,7 @@       in class'            [var "Real" @@ a, var "Enum" @@ a]            "Integral"-           ["a"]+           [bvar "a"]            [ typeSig "divMod" $ a --> a --> tuple [a, a]            , typeSig "div" $ a --> a --> a            , funBind "div"@@ -159,7 +159,7 @@             , match [conP "False" []] $ string "False"             ]         ]-    , data' "X" ["b"]+    , data' "X" [bvar "b"]         [ prefixCon "X"             [ field $ var "A" @@ var "b"             , strict $ field $ var "A" @@ var "b"

@@ -35,14 +35,21 @@ testPats :: DynFlags ->  String -> [TestCase Pat'] -> TestTree testPats = testCases +testModule :: DynFlags -> String -> [TestCase HsModule'] -> TestTree+testModule = testCases  main :: IO () main = runGhc (Just libdir) $ do     dflags <- getDynFlags     liftIO $ defaultMain $ testGroup "Tests"-        [typesTest dflags, exprsTest dflags, declsTest dflags, patsTest dflags]+        [ typesTest dflags+        , exprsTest dflags+        , declsTest dflags+        , patsTest dflags+        , modulesTest dflags+        ] -typesTest, exprsTest, declsTest, patsTest :: DynFlags -> TestTree+typesTest, exprsTest, declsTest, patsTest, modulesTest :: DynFlags -> TestTree typesTest dflags = testGroup "Type"     [ test "var"         [ "A" :~ var "A"@@ -92,13 +99,20 @@         , "123" :~ numTy 123         ]     , test "unit"-        [ "()" :~ unit ]+        [ "()" :~ unit+        , "(# #)" :~ unboxedTuple []+        ]    , test "list"         [ "[x]" :~ listTy (var "x")         , "'[]" :~ listPromotedTy []         , "'[x]" :~ listPromotedTy [var "x"]         , "'[y, z]" :~ listPromotedTy [var "y", var "z"]         ]+    , test "tuple"+        [ "(a, b)" :~ tuple [(var "a"), (var "b")]+        , "(# a, b #)" :~ unboxedTuple [(var "a"), (var "b")]+        , "'(a, b)" :~ tuplePromotedTy [(var "a"), (var "b")]+        ]     , test "tyPromotedVar"         -- For some reason, older GHC pretty-printed an extra space.         [ ifGhc88 "'Abc" " 'Abc" :~ tyPromotedVar "Abc"@@ -207,6 +221,22 @@         -- TODO: add more tests.         [ "do (let x = 1 in x)" :~ do' [stmt $ let' [valBind "x" (int 1)] (var "x")]         ]+    , test "arithSeq"+        [ "[a .. ]" :~ from (var "a")+        , "[a, b .. ]" :~ fromThen (var "a") (var "b")+        , "[a .. b]" :~ fromTo (var "a") (var "b")+        , "[a, b .. c]" :~ fromThenTo (var "a") (var "b") (var "c")+        ]+    , test "list comprehension"+        [ "[x | x <- [1 .. 10]]" :~+            listComp (bvar "x") [bvar "x" <-- fromTo (int 1) (int 10)]+        , "[x + y | x <- [1 .. 10], y <- [11 .. 20], even y]" :~+            listComp (op (bvar "x") "+" (bvar "y"))+                     [ bvar "x" <-- fromTo (int 1) (int 10)+                     , bvar "y" <-- fromTo (int 11) (int 20)+                     , stmt $ var "even" @@ bvar "y"+                     ]+        ]     ]   where     test = testExprs dflags@@ -272,6 +302,28 @@         [ "pattern F a b = G b a"             :~ patSynBind "F" ["a", "b"] $ conP "G" [bvar "b", bvar "a"]         ]+   , test "dataDecl"+        [ "data Either a b\n  = Left a | Right b\n  deriving Show"+            :~ data' "Either" [bvar "a", bvar "b"]+               [ prefixCon "Left" [field $ var "a"]+               , prefixCon "Right" [field $ var "b"]+               ] $ [deriving' [var "Show"]]+        , "data Either a (b :: Type)\n  = Left a | Right b\n  deriving Show"+            :~ data' "Either" [bvar "a", kindedVar "b" (var "Type")]+               [ prefixCon "Left" [field $ var "a"]+               , prefixCon "Right" [field $ var "b"]+               ] $ [deriving' [var "Show"]]+        ]+    , test "newtypeDecl"+        [ "newtype Const a b\n  = Const a\n  deriving Show"+            :~ newtype' "Const" [bvar "a", bvar "b"]+               (prefixCon "Const" [field $ var "a"])+               $ [deriving' [var "Show"]]+        , "newtype Const a (b :: Type)\n  = Const a\n  deriving Show"+            :~ newtype' "Const" [bvar "a", kindedVar "b" (var "Type")]+               (prefixCon "Const" [field $ var "a"])+               [deriving' [var "Show"]]+        ]     ]   where     test = testDecls dflags@@ -324,3 +376,15 @@   where     test = testPats dflags +-- TODO: Add more test cases from pprint_examples.hs.+modulesTest dflags = testGroup "Modules"+    [ test "import"+        [ "import M" :~+            module' Nothing Nothing [import' "M"] []+        , "import {-# SOURCE #-} M" :~+            module' Nothing Nothing+                [source $ import' "M"] []+        ]+    ]+  where+    test = testModule dflags