Support GHC 9.6

ghc-show-ast/Main.hs

@@ -13,7 +13,14 @@ import Data.Typeable (cast)
 import System.Environment (getArgs)
 import Text.PrettyPrint
 
-#if MIN_VERSION_ghc(9,2,0)
+#if MIN_VERSION_ghc(9,4,0)
+import GHC.Driver.Config.Diagnostic (initDiagOpts)
+import GHC.Driver.Config.Parser (initParserOpts)
+import qualified GHC.Driver.Errors as Error (printMessages)
+#if MIN_VERSION_ghc(9,6,0)
+import qualified GHC.Types.Error as GHC (NoDiagnosticOpts(..))
+#endif
+#elif MIN_VERSION_ghc(9,2,0)
 import qualified GHC.Driver.Errors as Error
 import qualified GHC.Parser.Errors.Ppr as Error
 #elif MIN_VERSION_ghc(9,0,0)
@@ -103,18 +110,35 @@ main = do
     result <- parseModule f
     print $ gPrint result
 
-#if MIN_VERSION_ghc(9,0,1)
+#if MIN_VERSION_ghc(9,0,1) && !MIN_VERSION_ghc(9,6,0)
 parseModule :: FilePath -> IO GHC.HsModule
 #else
 parseModule :: FilePath -> IO (GHC.HsModule GHC.GhcPs)
 #endif
 parseModule f = GHC.runGhc (Just libdir) $ do
     dflags <- GHC.getDynFlags
     contents <- GHC.liftIO $ GHC.stringToStringBuffer <$> readFile f
+#if MIN_VERSION_ghc(9,4,0)
+    let (_, options) = GHC.getOptions (initParserOpts dflags) contents f
+#else
     let options = GHC.getOptions dflags contents f
+#endif
     (dflags', _, _) <- GHC.parseDynamicFilePragma dflags options
 
-#if MIN_VERSION_ghc(9,2,0)
+#if MIN_VERSION_ghc(9,4,0)
+    let diagOpts = initDiagOpts dflags'
+        state =
+            GHC.initParserState
+                ( GHC.mkParserOpts
+                    (GHC.extensionFlags dflags')
+                    diagOpts
+                    []
+                    (GHC.safeImportsOn dflags')
+                    (GHC.gopt GHC.Opt_Haddock dflags')
+                    (GHC.gopt GHC.Opt_KeepRawTokenStream dflags')
+                    True
+                )
+#elif MIN_VERSION_ghc(9,2,0)
     let state =
             GHC.initParserState
                 ( GHC.mkParserOpts
@@ -135,7 +159,18 @@ parseModule f = GHC.runGhc (Just libdir) $ do
 
     case GHC.unP Parser.parseModule state of
         GHC.POk _state m -> return $ GHC.unLoc m
-#if MIN_VERSION_ghc(9,2,0)
+#if MIN_VERSION_ghc(9,4,0)
+        GHC.PFailed s -> do
+            logger <- GHC.getLogger
+            liftIO $ do
+                let errors = GHC.getPsErrorMessages s
+#  if MIN_VERSION_ghc(9,6,0)
+                Error.printMessages logger GHC.NoDiagnosticOpts diagOpts errors
+#  else
+                Error.printMessages logger diagOpts errors
+#  endif
+                exitFailure
+#elif MIN_VERSION_ghc(9,2,0)
         GHC.PFailed s -> do
             logger <- GHC.getLogger
             liftIO $ do

ghc-source-gen.cabal

@@ -61,7 +61,7 @@ library
       TypeSynonymInstances
   build-depends:
       base >=4.7 && <5
-    , ghc >=8.4 && <9.5
+    , ghc >=8.4 && <9.7
   if impl(ghc<8.10)
     other-modules:
         GHC.Hs
@@ -104,7 +104,7 @@ test-suite name_test
   build-depends:
       QuickCheck >=2.10 && <2.15
     , base >=4.7 && <5
-    , ghc >=8.4 && <9.5
+    , ghc >=8.4 && <9.7
     , ghc-source-gen
     , tasty >=1.0 && <1.5
     , tasty-hunit ==0.10.*
@@ -125,7 +125,7 @@ test-suite pprint_examples
       TypeSynonymInstances
   build-depends:
       base >=4.7 && <5
-    , ghc >=8.4 && <9.5
+    , ghc >=8.4 && <9.7
     , ghc-paths ==0.1.*
     , ghc-source-gen
     , tasty >=1.0 && <1.5
@@ -151,7 +151,7 @@ test-suite pprint_test
       TypeSynonymInstances
   build-depends:
       base >=4.7 && <5
-    , ghc >=8.4 && <9.5
+    , ghc >=8.4 && <9.7
     , ghc-paths ==0.1.*
     , ghc-source-gen
     , tasty >=1.0 && <1.5

package.yaml

@@ -30,7 +30,7 @@ description: |
 
 dependencies:
 - base >= 4.7 && < 5
-- ghc >= 8.4 && < 9.5
+- ghc >= 8.4 && < 9.7
 
 default-extensions:
 - DataKinds

src/GHC/SourceGen/Binds.hs

@@ -101,12 +101,14 @@ typeSig n = typeSigs [n]
 funBindsWithFixity :: HasValBind t => Maybe LexicalFixity -> OccNameStr -> [RawMatch] -> t
 funBindsWithFixity fixity name matches = bindB $ withPlaceHolder
         (noExt FunBind name'
-            (matchGroup context matches) 
+            (matchGroup context matches)
 #if !MIN_VERSION_ghc(9,0,1)
             WpHole
 #endif
             )
+#if !MIN_VERSION_ghc(9,6,0)
         []
+#endif
   where
     name' = valueRdrName $ unqual name
     occ = valueOccName name
@@ -189,7 +191,9 @@ patBindGRHSs p g =
         $ withPlaceHolder
             (withPlaceHolder
                 (withEpAnnNotUsed PatBind (builtPat p) (mkGRHSs g)))
+#if !MIN_VERSION_ghc(9,6,0)
         $ ([],[])
+#endif
 
 -- | Defines a pattern binding without any guards.
 --

src/GHC/SourceGen/Binds/Internal.hs

@@ -83,12 +83,19 @@ data RawGRHSs = RawGRHSs
 
 matchGroup :: HsMatchContext' -> [RawMatch] -> MatchGroup' LHsExpr'
 matchGroup context matches =
-    noExt MG (mkLocated $ map (mkLocated . mkMatch) matches)
+#if MIN_VERSION_ghc(9,6,0)
+    MG Generated
+#else
+    noExt MG
+#endif
+                            matches'
 #if !MIN_VERSION_ghc(8,6,0)
                             [] PlaceHolder
-#endif
+#elif !MIN_VERSION_ghc(9,6,0)
                             Generated
+#endif                            
   where
+    matches' = mkLocated $ map (mkLocated . mkMatch) matches
     mkMatch :: RawMatch -> Match' LHsExpr'
     mkMatch r = withEpAnnNotUsed Match context
                     (map builtPat $ map parenthesize $ rawMatchPats r)

src/GHC/SourceGen/Decl.hs

@@ -54,15 +54,20 @@ module GHC.SourceGen.Decl
 #if MIN_VERSION_ghc(9,0,0)
 import GHC (LexicalFixity(Prefix))
 import GHC.Data.Bag (listToBag)
-import GHC.Types.SrcLoc (LayoutInfo(..))
+
+#if MIN_VERSION_ghc(9,6,0)
+import GHC (GhcPs, LayoutInfo (NoLayoutInfo))
+#else
+import GHC.Types.SrcLoc (LayoutInfo(NoLayoutInfo))
+#endif
+
 #else
 import BasicTypes (LexicalFixity(Prefix))
 import Bag (listToBag)
 #endif
 #if !MIN_VERSION_ghc(8,6,0)
 import BasicTypes (DerivStrategy(..))
 #endif
-import GHC (GhcPs)
 import GHC.Hs.Binds
 import GHC.Hs.Decls
 
@@ -108,6 +113,7 @@ import GHC.SourceGen.Name
 import GHC.SourceGen.Name.Internal
 import GHC.SourceGen.Syntax.Internal
 import GHC.SourceGen.Type.Internal
+import GHC.Hs
 
 -- | A definition that can appear in the body of a @class@ declaration.
 --
@@ -174,7 +180,10 @@ class'
 class' context name vars decls
     = noExt TyClD $ ClassDecl
             { tcdCtxt = toHsContext $ mkLocated $ map mkLocated context
-#if MIN_VERSION_ghc(9,2,0)
+#if MIN_VERSION_ghc(9,6,0)
+            , tcdLayout = NoLayoutInfo
+            , tcdCExt = (EpAnnNotUsed, NoAnnSortKey)
+#elif MIN_VERSION_ghc(9,2,0)
             , tcdCExt = (EpAnnNotUsed, NoAnnSortKey, NoLayoutInfo)
 #elif MIN_VERSION_ghc(9,0,0)
             , tcdCExt = NoLayoutInfo
@@ -323,11 +332,23 @@ newOrDataType newOrData name vars conDecls derivs
         withEpAnnNotUsed DataDecl (typeRdrName $ unqual name)
             (mkQTyVars vars)
             Prefix
-            $ noExt HsDataDefn newOrData
+            $ noExt HsDataDefn
+#if !MIN_VERSION_ghc(9,6,0)
+                newOrData
+#endif
                 cxt
                 Nothing
                 Nothing
+#if MIN_VERSION_ghc(9,6,0)
+                (case newOrData of
+                    NewType -> case conDecls of
+                        [decl] -> NewTypeCon $ mkLocated decl
+                        _ -> error "NewTypeCon with more than one decl"
+                    DataType -> DataTypeCons False (map mkLocated conDecls)
+                )  
+#else
                 (map mkLocated conDecls)
+#endif
 #if MIN_VERSION_ghc(9,4,0)
                 (toHsDeriving $ map mkLocated derivs)
 #else

src/GHC/SourceGen/Expr.hs

@@ -30,6 +30,10 @@ module GHC.SourceGen.Expr
 
 import GHC.Hs.Expr
 import GHC.Hs.Extension (GhcPs)
+#if MIN_VERSION_ghc(9,6,0)
+import GHC.Hs.Extension (noHsTok)
+import GHC.Types.SourceText (SourceText(NoSourceText))
+#endif
 #if MIN_VERSION_ghc(9,4,0)
 import GHC.Hs.Pat (HsFieldBind(..), HsRecFields(..))
 #else
@@ -67,7 +71,9 @@ import GHC.SourceGen.Type.Internal
 overLabel :: String -> HsExpr'
 overLabel = hsOverLabel . fromString
   where
-#if MIN_VERSION_ghc(9,2,0)
+#if MIN_VERSION_ghc(9,6,0)
+    hsOverLabel = withEpAnnNotUsed HsOverLabel NoSourceText
+#elif MIN_VERSION_ghc(9,2,0)
     hsOverLabel = withEpAnnNotUsed HsOverLabel
 #else
     hsOverLabel = noExt HsOverLabel Nothing
@@ -198,7 +204,9 @@ e @::@ t = ExprWithTySig (builtLoc e) (sigWcType t)
 -- > =====
 -- > var "f" @@ var "Int"
 tyApp :: HsExpr' -> HsType' -> HsExpr'
-#if MIN_VERSION_ghc(9,2,0)
+#if MIN_VERSION_ghc(9,6,0)
+tyApp e t = noExt HsAppType e' noHsTok t'
+#elif 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'