packages feed

ghc-lib-parser-ex 9.6.0.2 → 9.14.2.0

raw patch · 24 files changed

Files

+ CI.hs view
@@ -0,0 +1,150 @@+-- Copyright (c) 2020, 2024 Shayne Fletcher. All rights reserved.+-- SPDX-License-Identifier: BSD-3-Clause.+{-# LANGUAGE CPP #-}+{-# LANGUAGE NamedFieldPuns #-}++import Control.Monad.Extra+#if __GLASGOW_HASKELL__ < 906+import Control.Applicative (liftA2)+#endif+import Data.Bifunctor+import Data.List.Extra+import Data.Time.Calendar+import Data.Time.Clock+import qualified Options.Applicative as Opts+import System.Exit+import System.IO.Extra+import System.Process.Extra++main :: IO ()+main = do+  let opts =+        Opts.info+          (parseOptions Opts.<**> Opts.helper)+          ( Opts.fullDesc+              <> Opts.progDesc "Build and test ghc-lib-parser-ex."+              <> Opts.header "CI - CI script for ghc-lib-parser-ex"+          )+  options <- Opts.execParser opts+  buildTestDist options++buildTestDist :: Options -> IO ()+buildTestDist Options {versionTag = userGivenTag, noBuilds} = do+  assignVersionPatchCabal userGivenTag++  system_ "cabal sdist -o ."+  when noBuilds exitSuccess+  system_ "cabal build lib:ghc-lib-parser-ex --ghc-options=-j"+  system_ "cabal test test:ghc-lib-parser-ex-test --ghc-options=-j --test-show-details=direct --test-options=\"--color always\""+#if __GLASGOW_HASKELL__ == 808 && \+    (__GLASGOW_HASKELL_PATCHLEVEL1__ == 1 || __GLASGOW_HASKELL_PATCHLEVEL1__ == 2) && \+    defined (mingw32_HOST_OS)+      -- https://gitlab.haskell.org/ghc/ghc/issues/17599+#else+  system_ "cabal exec -- ghc -ignore-dot-ghci -package=ghc-lib-parser-ex -e \"print 1\""+#endif++assignVersionPatchCabal :: Maybe String -> IO ()+assignVersionPatchCabal userTag = do+  version <- mkVersion userTag+  patchCabal version+  contents <- readFile' "ghc-lib-parser-ex.cabal"+  putStrLn contents+  hFlush stdout+  where+    mkVersion :: Maybe String -> IO String+    mkVersion = maybe (do UTCTime day _ <- getCurrentTime; pure $ genVersionStr day) pure++    genVersionStr :: Day -> String+    genVersionStr day = "0." ++ replace "-" "" (showGregorian day)++patchCabal :: String -> IO ()+patchCabal version = do+  putStrLn "Patching cabal:"+  putStrLn $ "- version " ++ version+  writeFile "ghc-lib-parser-ex.cabal"+    . replace "version: 0.1.0" ("version: " ++ version)+    =<< readFile' "ghc-lib-parser-ex.cabal"+  let series+        | Just (major, Just (minor, _)) <- second (stripInfix ".") <$> stripInfix "." version = liftA2 (,) (maybeRead major) (maybeRead minor)+        | otherwise = Nothing+  case series of+    Just (major, minor) -> do+      let (lower, upper, family) = bounds (major, minor)+      putStrLn $ "- ghc >= " ++ lower ++ " && ghc < " ++ upper+      putStrLn $ "- ghc-lib-parser " ++ family+      writeFile "ghc-lib-parser-ex.cabal"+        . replace "9.0.0" lower+        . replace "9.1.0" upper+        . replace "9.0.*" family+        =<< readFile' "ghc-lib-parser-ex.cabal"+    Nothing -> do+      let ghcLibParserVersion = version+      putStrLn $ "- ghc-lib-parser " ++ ghcLibParserVersion+      writeFile "ghc-lib-parser-ex.cabal"+        . replace+          buildDependsSection+          ( unlines+              [ "  build-depends:",+                "      ghc-lib-parser == " ++ ghcLibParserVersion,+                "  -- pseduo use of flags to suppress cabal check warnings",+                "  if flag(auto)",+                "  if flag(no-ghc-lib)"+              ]+          )+        =<< readFile' "ghc-lib-parser-ex.cabal"+  where+    maybeRead :: String -> Maybe Int+    maybeRead s+      | [(x, "")] <- reads s = Just x+      | otherwise = Nothing++    buildDependsSection :: String+    buildDependsSection =+      unlines+        [ "  if flag(auto) && impl(ghc >= 9.0.0) && impl(ghc < 9.1.0)",+          "    build-depends:",+          "      ghc == 9.0.*,",+          "      ghc-boot-th,",+          "      ghc-boot",+          "  else",+          "    if flag(auto)",+          "      build-depends:",+          "        ghc-lib-parser == 9.0.*",+          "    else",+          "      if flag(no-ghc-lib)",+          "        build-depends:",+          "          ghc == 9.0.*,",+          "          ghc-boot-th,",+          "          ghc-boot",+          "      else",+          "        build-depends:",+          "          ghc-lib-parser == 9.0.*"+        ]++    bounds :: (Int, Int) -> (String, String, String)+    bounds (major, minor) =+      let lower = if lower' == "9.2.0" then "9.2.2" else lower'+          upper = upper'+          family = family'+       in (lower, upper, family)+      where+        lower' = show major ++ "." ++ show minor ++ ".0"+        upper' = show major ++ "." ++ show (minor + 1) ++ ".0"+        family' = show major ++ "." ++ show minor ++ ".*"++data Options = Options+  { versionTag :: Maybe String, -- If 'Just _' use this as the version (e.g. "8.8.1.20191204")+    noBuilds :: Bool -- Don't build or run tests+  }+  deriving (Show)++parseOptions :: Opts.Parser Options+parseOptions =+  Options+    <$> Opts.optional+      ( Opts.strOption+          (Opts.long "version-tag" <> Opts.help "Set version")+      )+    <*> Opts.switch+      (Opts.long "no-builds" <> Opts.help "If enabled, stop after producing sdists")
ChangeLog.md view
@@ -1,14 +1,34 @@ # Changelog for ghc-lib-parser-ex -# 9.6.0.2 released+# Unreleased+- Add support for ghc-9.14 series: `GHCLIB_API_914`++# 9.12.0.0 released+- Add support for ghc-9.12 series: `GHCLIB_API_912`++## 9.10.0.0 released+- Deprecate `Dump`+- New module `GHC.Hs.Dump`+- Add support for ghc-9.10 series: `GHCLIB_API_910`++## 9.8.0.2 released+- Fix broken cpp in `isStrictMatch`++## 9.8.0.1 released+- New functions `isWildPat`++## 9.8.0.0 released+- Companion to `ghc-lib-parser-9.8.1.20231009`++## 9.6.0.2 released - New functions `isTypedSplice`, `isUntypedSpice` -# 9.6.0.1 released+## 9.6.0.1 released - Add `&` to `baseFixities` - Add support for ghc-9.8 series: `GH_9_8` - New functions `isLetStmt` and `isDo` -# 9.6.0.0 released+## 9.6.0.0 released - Add support for ghc-9.6 series: `GHC_9_6`  ## 0.20221201 released
README.md view
@@ -1,5 +1,7 @@-# ghc-lib-parser-ex [![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) [![Hackage version](https://img.shields.io/hackage/v/ghc-lib-parser-ex.svg?label=Hackage)](https://hackage.haskell.org/package/ghc-lib-parser-ex) [![Stackage version](https://www.stackage.org/package/ghc-lib-parser-ex/badge/nightly?label=Stackage)](https://www.stackage.org/package/ghc-lib-parser-ex)  [![Build Status](https://shayne-fletcher.visualstudio.com/ghc-lib-parser-ex/_apis/build/status/shayne-fletcher.ghc-lib-parser-ex?branchName=master)](https://shayne-fletcher.visualstudio.com/ghc-lib-parser-ex/_build/latest?definitionId=1&branchName=master)-Copyright © 2020-2022 Shayne Fletcher. All rights reserved.+# ghc-lib-parser-ex+ [![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) [![Hackage version](https://img.shields.io/hackage/v/ghc-lib-parser-ex.svg?label=Hackage)](https://hackage.haskell.org/package/ghc-lib-parser-ex) [![Stackage version](https://www.stackage.org/package/ghc-lib-parser-ex/badge/nightly?label=Stackage)](https://www.stackage.org/package/ghc-lib-parser-ex) [![ghc-lib-parser-ex-ghc-lib-parser-9.10.1.20240511](https://github.com/shayne-fletcher/ghc-lib-parser-ex/actions/workflows/ghc-lib-parser-ex-ghc-lib-parser-9.10.1.20240511.yml/badge.svg)](https://github.com/shayne-fletcher/ghc-lib-parser-ex/actions/workflows/ghc-lib-parser-ex-ghc-lib-parser-9.10.1.20240511.yml)++Copyright © 2020-2024 Shayne Fletcher. All rights reserved. SPDX-License-Identifier: BSD-3-Clause  The `ghc-lib-parser-ex` package contains GHC API parse tree utilities. It works with or without [`ghc-lib-parser`](https://github.com/digital-asset/ghc-lib).@@ -10,7 +12,9 @@  ### Versioning policy -Package `ghc-lib-parser-ex` does **not** conform to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). Version numbers are of the form α.β.γ.δ where α.β corresponds to a GHC series and γ.δ are the major and minor parts of the `ghc-lib-ex-parser` package release. Examples:+Package `ghc-lib-parser-ex` does **not** conform to the [Haskell Package Versioning Policy](https://pvp.haskell.org/).++Version numbers are of the form α.β.γ.δ where α.β corresponds to a GHC series and γ.δ are the major and minor parts of the `ghc-lib-ex-parser` package release. Examples: * Version 8.10.1.3 is compatible with any `ghc-lib-parser-8.10.*` (or `ghc-8.10.*`) package; * Version 0.20190204.2.0 is compatible with [`ghc-lib-parser-0.20190204`](http://hackage.haskell.org/package/ghc-lib-0.20190204). @@ -20,12 +24,10 @@  Produce and test `ghc-lib-parser-ex` package distributions by executing the CI script: ```bash-# Setup-git clone git@github.com:shayne-fletcher/ghc-lib-parser-ex.git-cd ghc-lib-parser-ex-stack runhaskell --package extra --package optparse-applicative CI.hs+    git clone git@github.com:shayne-fletcher/ghc-lib-parser-ex.git+    cd ghc-lib-parser-ex+    cabal run exe:ghc-lib-parser-ex-build-tool --allow-newer="ghc-lib-parser-ex:ghc-lib-parser" --constraint="ghc-lib-parser == 9.10.1.20240511" -- --version-tag 9.10.0.1 ```-Run `stack runhaskell --package extra --package optparse-applicative CI.hs -- --help` for more options.  To run [`hlint`](https://github.com/ndmitchell/hlint) on this repository, `hlint --cpp-include cbits --cpp-define GHC_XXXX .` (where `XXXX` at this time is one of `8_8`, `8_10`, `9_0`, `9_2`, `9_4`, `9_6`, `9_8` or `9_10`). 
cbits/ghclib_api.h view
@@ -1,12 +1,15 @@ /*-Copyright (c) 2020 - 2023 Shayne Fletcher. All rights reserved.+Copyright (c) 2020 - 2024 Shayne Fletcher. All rights reserved. SPDX-License-Identifier: BSD-3-Clause. */  #if !defined(GHCLIB_API_H) #  define GHCLIB_API_H -#  if !(defined (GHC_9_10) \+#  if !(defined (GHC_9_16) \+     || defined (GHC_9_14) \+     || defined (GHC_9_12) \+     || defined (GHC_9_10) \      || defined (GHC_9_8)  \      || defined (GHC_9_6)  \      || defined (GHC_9_4)  \@@ -16,6 +19,12 @@      || defined (GHC_8_8)) #    if defined (MIN_VERSION_ghc_lib_parser) #       if !MIN_VERSION_ghc_lib_parser ( 1,  0,  0)+#         define GHC_9_16+#       elif MIN_VERSION_ghc_lib_parser (9,  14,  0)+#         define GHC_9_14+#       elif MIN_VERSION_ghc_lib_parser (9,  12,  0)+#         define GHC_9_12+#       elif MIN_VERSION_ghc_lib_parser (9,  10,  0) #         define GHC_9_10 #       elif MIN_VERSION_ghc_lib_parser (9,  8,  0) #         define GHC_9_8@@ -35,7 +44,13 @@ #         error Unsupported GHC API version #      endif #    else-#      if __GLASGOW_HASKELL__   == 909+#      if __GLASGOW_HASKELL__   == 916+#        define GHC_9_16+#      elif __GLASGOW_HASKELL__   == 914+#        define GHC_9_14+#      elif __GLASGOW_HASKELL__ == 912+#        define GHC_9_12+#      elif __GLASGOW_HASKELL__ == 910 #        define GHC_9_10 #      elif __GLASGOW_HASKELL__ == 908 #        define GHC_9_8
ghc-lib-parser-ex.cabal view
@@ -1,21 +1,19 @@-cabal-version:  1.18-name:           ghc-lib-parser-ex-version:        9.6.0.2-description:    Please see the README on GitHub at <https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme>-homepage:       https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme-bug-reports:    https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues-author:         Shayne Fletcher-maintainer:     shayne@shaynefletcher.org-copyright:      Copyright © 2020-2022 Shayne Fletcher. All rights reserved.-license:        BSD3+cabal-version: 3.4+name: ghc-lib-parser-ex+version: 9.14.2.0+description: Please see the README on GitHub at <https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme>+homepage: https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme+bug-reports: https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues+author: Shayne Fletcher+maintainer: shayne@shaynefletcher.org+copyright: Copyright © 2020-2024 Shayne Fletcher. All rights reserved.+license: BSD-3-Clause license-file:   LICENSE-category:       Development-synopsis:       Algorithms on GHC parse trees-build-type:     Simple+category: Development+synopsis: Programming with GHC parse trees+build-type: Simple extra-source-files:-    README.md-    ChangeLog.md-    cbits/ghclib_api.h+    README.md ChangeLog.md cbits/ghclib_api.h  source-repository head   type: git@@ -29,9 +27,47 @@ flag no-ghc-lib   default: False   manual: True-  description: Force dependency on native ghc-libs+  description: Do not link ghc-lib. Use the native GHC libs +common base+  default-language: Haskell2010+  ghc-options:+    -Wall -Wincomplete-record-updates -Wredundant-constraints -Widentities+    -Wunused-imports -Wno-name-shadowing+  build-depends:+      base >=4.7 && <5++common ghc_libs+  include-dirs: cbits+  default-extensions: CPP+  if flag(auto) && impl(ghc >= 9.14.0) && impl(ghc < 9.15.0)+    build-depends:+      ghc == 9.14.*,+      ghc-boot-th,+      ghc-boot+  else+    if flag(auto)+      build-depends:+        ghc-lib-parser == 9.14.*+    else+      if flag(no-ghc-lib)+        build-depends:+          ghc == 9.14.*,+          ghc-boot-th,+          ghc-boot+      else+        build-depends:+          ghc-lib-parser == 9.14.*++common lib+  import: base, ghc_libs+  build-depends:+      uniplate >= 1.5,+      bytestring >= 0.10.8.2,+      containers >= 0.5.8.1+ library+  import: lib   exposed-modules:       Language.Haskell.GhclibParserEx.Dump       Language.Haskell.GhclibParserEx.Fixity@@ -39,6 +75,7 @@       Language.Haskell.GhclibParserEx.GHC.Driver.Flags       Language.Haskell.GhclibParserEx.GHC.Driver.Session       Language.Haskell.GhclibParserEx.GHC.Hs+      Language.Haskell.GhclibParserEx.GHC.Hs.Dump       Language.Haskell.GhclibParserEx.GHC.Hs.Expr       Language.Haskell.GhclibParserEx.GHC.Hs.Pat       Language.Haskell.GhclibParserEx.GHC.Hs.Type@@ -50,75 +87,25 @@       Language.Haskell.GhclibParserEx.GHC.Parser       Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader       Language.Haskell.GhclibParserEx.GHC.Utils.Outputable-  other-modules:-      Paths_ghc_lib_parser_ex-  hs-source-dirs:-      src+  autogen-modules: Paths_ghc_lib_parser_ex+  other-modules: Paths_ghc_lib_parser_ex+  hs-source-dirs: src++common test+  import: lib   build-depends:-      base >=4.7 && <5,-      uniplate >= 1.5,-      bytestring >= 0.10.8.2,-      containers >= 0.5.8.1-  if flag(auto) && impl(ghc >= 9.6.0) && impl(ghc < 9.7.0)-    build-depends:-      ghc == 9.6.*,-      ghc-boot-th,-      ghc-boot-  else-    if flag(auto)-      build-depends:-        ghc-lib-parser == 9.6.*-    else-      if flag(no-ghc-lib)-        build-depends:-          ghc == 9.6.*,-          ghc-boot-th,-          ghc-boot-      else-        build-depends:-          ghc-lib-parser == 9.6.*-  include-dirs:-      cbits-  install-includes:-      cbits/ghclib_api.h-  default-language: Haskell2010+    tasty >= 1.2, tasty-hunit >= 0.10.0, directory >= 1.3.1,+    filepath >= 1.4.2, extra >=1.6, uniplate >= 1.6.12,+    ghc-lib-parser-ex  test-suite ghc-lib-parser-ex-test+  import: test   type: exitcode-stdio-1.0-  main-is:-      Test.hs-  other-modules:-      Paths_ghc_lib_parser_ex-  hs-source-dirs:-      test-  include-dirs:-      cbits   ghc-options: -threaded -rtsopts -with-rtsopts=-N-  build-depends:-      base >=4.7 && <5-    , tasty >= 1.2-    , tasty-hunit >= 0.10.0-    , directory >= 1.3.3-    , filepath >= 1.4.2-    , extra >=1.6-    , uniplate >= 1.6.12-    , ghc-lib-parser-ex-  if flag(auto) && impl(ghc >= 9.6.0) && impl(ghc < 9.7.0)-    build-depends:-      ghc == 9.6.*,-      ghc-boot-th,-      ghc-boot-  else-    if flag(auto)-      build-depends:-        ghc-lib-parser == 9.6.*-    else-      if flag(no-ghc-lib)-        build-depends:-          ghc == 9.6.*,-          ghc-boot-th,-          ghc-boot-      else-        build-depends:-          ghc-lib-parser == 9.6.*-  default-language: Haskell2010+  main-is: Test.hs+  hs-source-dirs: test++executable ghc-lib-parser-ex-build-tool+  import: base+  build-depends: directory, filepath, time, extra, optparse-applicative+  main-is: CI.hs
src/Language/Haskell/GhclibParserEx/Dump.hs view
@@ -1,242 +1,10 @@--- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved.+-- Copyright (c) 2024, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause.-{--(c) The University of Glasgow 2006-(c) The GRASP/AQUA Project, Glasgow University, 1992-1998--}-{- HLINT ignore -} -- Not our code.-{-# LANGUAGE CPP #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-#include "ghclib_api.h"-module Language.Haskell.GhclibParserEx.Dump(-    showAstData-  , BlankSrcSpan(..)-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)-  , BlankEpAnnotations(..)-#endif-) where -#if !defined(MIN_VERSION_ghc_lib_parser)--- Using native ghc.-#  if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined(GHC_9_0) || defined (GHC_8_10)-import GHC.Hs.Dump-#  else-import HsDumpAst-#  endif-#else--- Using ghc-lib-parser. Recent versions will include--- GHC.Hs.Dump (it got moved in from ghc-lib on 2020-02-05).-# if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-import GHC.Hs.Dump-#  else--- For simplicity, just assume it's missing from 8.8 ghc-lib-parser--- builds and reproduce the implementation.-import Prelude as X hiding ((<>))--import Data.Data hiding (Fixity)-import Bag-import BasicTypes-import FastString-import NameSet-import Name-import DataCon-import SrcLoc-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-import GHC.Hs-#else-import HsSyn-#endif-import OccName hiding (occName)-import Var-import Module-import Outputable--import qualified Data.ByteString as B--data BlankSrcSpan = BlankSrcSpan | NoBlankSrcSpan-                  deriving (Eq,Show)---- | Show a GHC syntax tree. This parameterised because it is also used for--- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked--- out, to avoid comparing locations, only structure-showAstData :: Data a => BlankSrcSpan -> a -> SDoc-showAstData b a0 = blankLine $$ showAstData' a0-  where-    showAstData' :: Data a => a -> SDoc-    showAstData' =-      generic-              `ext1Q` list-              `extQ` string `extQ` fastString `extQ` srcSpan-              `extQ` lit `extQ` litr `extQ` litt-              `extQ` bytestring-              `extQ` name `extQ` occName `extQ` moduleName `extQ` var-              `extQ` dataCon-              `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet-              `extQ` fixity-              `ext2Q` located--      where generic :: Data a => a -> SDoc-            generic t = parens $ text (showConstr (toConstr t))-                                  $$ vcat (gmapQ showAstData' t)--            string :: String -> SDoc-            string     = text . normalize_newlines . show--            fastString :: FastString -> SDoc-            fastString s = braces $-                            text "FastString: "-                         <> text (normalize_newlines . show $ s)--            bytestring :: B.ByteString -> SDoc-            bytestring = text . normalize_newlines . show--            list []    = brackets empty-            list [x]   = brackets (showAstData' x)-            list (x1 : x2 : xs) =  (text "[" <> showAstData' x1)-                                $$ go x2 xs-              where-                go y [] = text "," <> showAstData' y <> text "]"-                go y1 (y2 : ys) = (text "," <> showAstData' y1) $$ go y2 ys--            -- Eliminate word-size dependence-            lit :: HsLit GhcPs -> SDoc-            lit (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s-            lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s-            lit (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s-            lit (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s-            lit l                  = generic l--            litr :: HsLit GhcRn -> SDoc-            litr (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s-            litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s-            litr (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s-            litr (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s-            litr l                  = generic l--            litt :: HsLit GhcTc -> SDoc-            litt (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s-            litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s-            litt (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s-            litt (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s-            litt l                  = generic l--            numericLit :: String -> Integer -> SourceText -> SDoc-            numericLit tag x s = braces $ hsep [ text tag-                                               , generic x-                                               , generic s ]--            name :: Name -> SDoc-            name nm    = braces $ text "Name: " <> ppr nm--            occName n  =  braces $-                          text "OccName: "-                       <> text (OccName.occNameString n)--            moduleName :: ModuleName -> SDoc-            moduleName m = braces $ text "ModuleName: " <> ppr m--            srcSpan :: SrcSpan -> SDoc-            srcSpan ss = case b of-             BlankSrcSpan -> text "{ ss }"-             NoBlankSrcSpan -> braces $ char ' ' <>-                             (hang (ppr ss) 1-                                   -- TODO: show annotations here-                                   (text ""))--            var  :: Var -> SDoc-            var v      = braces $ text "Var: " <> ppr v--            dataCon :: DataCon -> SDoc-            dataCon c  = braces $ text "DataCon: " <> ppr c--            bagRdrName:: Bag (Located (HsBind GhcPs)) -> SDoc-            bagRdrName bg =  braces $-                             text "Bag(Located (HsBind GhcPs)):"-                          $$ (list . bagToList $ bg)--            bagName   :: Bag (Located (HsBind GhcRn)) -> SDoc-            bagName bg  =  braces $-                           text "Bag(Located (HsBind Name)):"-                        $$ (list . bagToList $ bg)--            bagVar    :: Bag (Located (HsBind GhcTc)) -> SDoc-            bagVar bg  =  braces $-                          text "Bag(Located (HsBind Var)):"-                       $$ (list . bagToList $ bg)--            nameSet ns =  braces $-                          text "NameSet:"-                       $$ (list . nameSetElemsStable $ ns)--            fixity :: Fixity -> SDoc-            fixity fx =  braces $-                         text "Fixity: "-                      <> ppr fx--            located :: (Data b,Data loc) => GenLocated loc b -> SDoc-            located (L ss a) = parens $-                   case cast ss of-                        Just (s :: SrcSpan) ->-                          srcSpan s-                        Nothing -> text "nnnnnnnn"-                      $$ showAstData' a--normalize_newlines :: String -> String-normalize_newlines ('\\':'r':'\\':'n':xs) = '\\':'n':normalize_newlines xs-normalize_newlines (x:xs)                 = x:normalize_newlines xs-normalize_newlines []                     = []--{--************************************************************************-*                                                                      *-* Copied from syb-*                                                                      *-************************************************************************--}----- | The type constructor for queries-newtype Q q x = Q { unQ :: x -> q }---- | Extend a generic query by a type-specific case-extQ :: ( Typeable a-        , Typeable b-        )-     => (a -> q)-     -> (b -> q)-     -> a-     -> q-extQ f g a = maybe (f a) g (cast a)---- | Type extension of queries for type constructors-ext1Q :: (Data d, Typeable t)-      => (d -> q)-      -> (forall e. Data e => t e -> q)-      -> d -> q-ext1Q def ext = unQ ((Q def) `ext1` (Q ext))----- | Type extension of queries for type constructors-ext2Q :: (Data d, Typeable t)-      => (d -> q)-      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)-      -> d -> q-ext2Q def ext = unQ ((Q def) `ext2` (Q ext))---- | Flexible type extension-ext1 :: (Data a, Typeable t)-     => c a-     -> (forall d. Data d => c (t d))-     -> c a-ext1 def ext = maybe def id (dataCast1 ext)+module Language.Haskell.GhclibParserEx.Dump+  {-# DEPRECATED "Use Language.Haskell.GhclibParserEx.GHC.Hs.Dump instead" #-}+  ( module Language.Haskell.GhclibParserEx.GHC.Hs.Dump,+  )+where --- | Flexible type extension-ext2 :: (Data a, Typeable t)-     => c a-     -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))-     -> c a-ext2 def ext = maybe def id (dataCast2 ext)-#  endif-#endif+import Language.Haskell.GhclibParserEx.GHC.Hs.Dump
src/Language/Haskell/GhclibParserEx/Fixity.hs view
@@ -1,49 +1,62 @@--- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved.+-- Copyright (c) 2020-2024, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. -- -- Adapted from (1) https://github.com/mpickering/apply-refact.git and -- (2) https://gitlab.haskell.org/ghc/ghc ('compiler/renamer/RnTypes.hs').--{-# LANGUAGE CPP #-}+{- ORMOLU_DISABLE -} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TupleSections #-} #include "ghclib_api.h"- module Language.Haskell.GhclibParserEx.Fixity(     applyFixities   , fixitiesFromModule   , preludeFixities, baseFixities   , infixr_, infixl_, infix_, fixity   ) where-#if defined (GHC_9_10) || defined (GHC_9_8)++#if defined (GHC_8_8)+import BasicTypes+import HsSyn+import OccName+import RdrName+import SrcLoc+#elif defined (GHC_8_10)+import BasicTypes+import GHC.Hs+import OccName+import RdrName+import SrcLoc+#elif defined  (GHC_9_0)+import GHC.Hs+import GHC.Types.Basic+import GHC.Types.Name+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc+#elif defined (GHC_9_2) || defined (GHC_9_4) || defined (GHC_9_6)+import GHC.Hs+import GHC.Types.Fixity+import GHC.Types.Name+import GHC.Types.Name.Reader+import GHC.Types.SourceText+import GHC.Types.SrcLoc+#elif defined (GHC_9_8) || defined (GHC_9_10) import GHC.Data.FastString-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0) import GHC.Hs-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) import GHC.Types.Fixity+import GHC.Types.Name+import GHC.Types.Name.Reader import GHC.Types.SourceText+import GHC.Types.SrcLoc #else-import GHC.Types.Basic-#endif+import GHC.Hs+import GHC.Types.Fixity import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Types.SrcLoc-#elif defined (GHC_8_10)-import GHC.Hs-import BasicTypes-import RdrName-import OccName-import SrcLoc-#else-import HsSyn-import BasicTypes-import RdrName-import OccName-import SrcLoc #endif-import Data.Maybe+ import Data.Data hiding (Fixity)+import Data.Maybe import Data.Generics.Uniplate.Data  #if defined (GHC_9_0) || defined (GHC_8_10)@@ -66,7 +79,7 @@ -- LPat and Pat have gone through a lot of churn. See -- https://gitlab.haskell.org/ghc/ghc/merge_requests/1925 for details. patFix :: [(String, Fixity)] -> LPat GhcPs -> LPat GhcPs-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)+#if ! ( defined (GHC_8_10) || defined (GHC_8_8) ) patFix fixities (L loc (ConPat _ op (InfixCon pat1 pat2))) =   L loc (mkConOpPat (getFixities fixities) op (findFixity' (getFixities fixities) op) pat1 pat2) #elif defined (GHC_8_10)@@ -80,7 +93,7 @@  mkConOpPat ::   [(String, Fixity)]-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))   -> LocatedN RdrName #else   -> Located RdrName@@ -88,21 +101,21 @@   -> Fixity   -> LPat GhcPs -> LPat GhcPs   -> Pat GhcPs-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)+#if ! ( defined (GHC_8_10) || defined (GHC_8_8) ) mkConOpPat fs op2 fix2 p1@(L loc (ConPat _ op1 (InfixCon p11 p12))) p2 #elif defined (GHC_8_10) mkConOpPat fs op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2 #else mkConOpPat fs op2 fix2 p1@(dL->L loc (ConPatIn op1 (InfixCon p11 p12))) p2 #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))   | nofix_error = ConPat noAnn op2 (InfixCon p1 p2) #elif defined (GHC_9_0)   | nofix_error = ConPat noExtField op2 (InfixCon p1 p2) #else   | nofix_error = ConPatIn op2 (InfixCon p1 p2) #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))   | associate_right = ConPat noAnn op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2))) #elif defined (GHC_9_0)   | associate_right = ConPat noExtField op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2)))@@ -111,7 +124,7 @@ #else   | associate_right = ConPatIn op1 (InfixCon p11 (cL loc (mkConOpPat fs op2 fix2 p12 p2))) #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))   | otherwise = ConPat noAnn op2 (InfixCon p1 p2) #elif defined (GHC_9_0)   | otherwise = ConPat noExtField op2 (InfixCon p1 p2)@@ -121,7 +134,7 @@   where     fix1 = findFixity' fs op1     (nofix_error, associate_right) = compareFixity fix1 fix2-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8)) mkConOpPat _ op _ p1 p2 = ConPat noAnn op (InfixCon p1 p2) #elif defined (GHC_9_0) mkConOpPat _ op _ p1 p2 = ConPat noExtField op (InfixCon p1 p2)@@ -131,7 +144,7 @@  mkOpApp ::    [(String, Fixity)]-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))    -> SrcSpanAnnA #else    -> SrcSpan@@ -142,14 +155,19 @@    -> LHsExpr GhcPs --      (e11 `op1` e12) `op2` e2 mkOpApp fs loc e1@(L _ (OpApp x1 e11 op1 e12)) op2 fix2 e2-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+# if ! ( defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc > 9.10+  | nofix_error = L loc (OpApp noExtField e1 op2 e2)+#elif ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc > 9.0   | nofix_error = L loc (OpApp noAnn e1 op2 e2) #else+-- otherwise   | nofix_error = L loc (OpApp noExt e1 op2 e2) #endif   | associate_right = L loc (OpApp x1 e11 op1 (mkOpApp fs loc' e12 op2 fix2 e2 ))   where-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))     loc'= combineLocsA e12 e2 #else     loc'= combineLocs e12 e2@@ -158,18 +176,23 @@     (nofix_error, associate_right) = compareFixity fix1 fix2 --      (- neg_arg) `op` e2 mkOpApp fs loc e1@(L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+# if ! ( defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc > 9.10+  | nofix_error = L loc (OpApp noExtField e1 op2 e2)+#elif ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc > 9.0   | nofix_error = L loc (OpApp noAnn e1 op2 e2) #else+-- otherwise   | nofix_error = L loc (OpApp noExt e1 op2 e2) #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))   | associate_right = L loc (NegApp noAnn (mkOpApp fs loc' neg_arg op2 fix2 e2) neg_name) #else   | associate_right = L loc (NegApp noExt (mkOpApp fs loc' neg_arg op2 fix2 e2) neg_name) #endif   where-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))     loc' = combineLocsA neg_arg e2 #else     loc' = combineLocs neg_arg e2@@ -177,7 +200,10 @@     (nofix_error, associate_right) = compareFixity negateFixity fix2 --      e1 `op` - neg_arg mkOpApp _ loc e1 op1 fix1 e2@(L _ NegApp {}) -- NegApp can occur on the right.-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+# if ! ( defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc > 9.10+  | not associate_right  = L loc (OpApp noExtField e1 op1 e2)-- We *want* right association.+#elif ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))   | not associate_right  = L loc (OpApp noAnn e1 op1 e2)-- We *want* right association. #else   | not associate_right  = L loc (OpApp noExt e1 op1 e2)-- We *want* right association.@@ -185,7 +211,10 @@   where     (_, associate_right) = compareFixity fix1 negateFixity  --     Default case, no rearrangment.-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+# if ! ( defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc > 9.10+mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noExtField e1 op e2)+#elif ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8)) mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noAnn e1 op e2) #else mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noExt e1 op e2)@@ -202,7 +231,7 @@ findFixity :: [(String, Fixity)] -> LHsExpr GhcPs -> Fixity findFixity fs r = askFix fs (getIdent r) -- Expressions. -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8)) findFixity' :: [(String, Fixity)] -> LocatedN RdrName -> Fixity #else findFixity' :: [(String, Fixity)] -> Located RdrName -> Fixity@@ -263,7 +292,9 @@ infix_  = fixity InfixN  fixity :: FixityDirection -> Int -> [String] -> [(String, Fixity)]-#if defined (GHC_9_10) || defined (GHC_9_8)+# if ! (defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+fixity a p = map (,Fixity p a)+#elif ! (defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) fixity a p = map (,Fixity (SourceText (fsLit "")) p a) #else fixity a p = map (,Fixity (SourceText "") p a)@@ -273,7 +304,7 @@ #else fixitiesFromModule :: Located (HsModule GhcPs) -> [(String, Fixity)] #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6)+#if ! (defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8)) fixitiesFromModule (L _ (HsModule _ _ _ _ decls)) = concatMap f decls #elif defined (GHC_9_4) || defined(GHC_9_2) fixitiesFromModule (L _ (HsModule _ _ _ _ _ decls _ _)) = concatMap f decls@@ -284,6 +315,10 @@ #endif   where     f :: LHsDecl GhcPs -> [(String, Fixity)]+# if ! (defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+    f (L _ (SigD _ (FixSig _ (FixitySig _ ops (Fixity p dir))))) =+#else     f (L _ (SigD _ (FixSig _ (FixitySig _ ops (Fixity _ p dir))))) =+#endif           fixity dir p (map (occNameString. rdrNameOcc . unLoc) ops)     f _ = []
src/Language/Haskell/GhclibParserEx/GHC/Driver/Flags.hs view
@@ -1,18 +1,14 @@ -- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause.--{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-orphans #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Driver.Flags () where -#if ! (defined (GHC_9_10) || defined (GHC_9_8) || defined(GHC_9_6) || defined(GHC_9_4)  || defined(GHC_9_2) || defined (GHC_9_0))+#if defined (GHC_8_10) || defined (GHC_8_8) import DynFlags-#endif  -- This instance landed in -- https://gitlab.haskell.org/ghc/ghc/merge_requests/2905.-#if defined (GHC_8_8) || defined(GHC_8_10) instance Bounded Language where   minBound = Haskell98   maxBound = Haskell2010
src/Language/Haskell/GhclibParserEx/GHC/Driver/Session.hs view
@@ -1,9 +1,9 @@ -- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. -{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -Wno-orphans #-}+{- ORMOLU_DISABLE -} #include "ghclib_api.h"+{-# OPTIONS_GHC -Wno-orphans #-} module Language.Haskell.GhclibParserEx.GHC.Driver.Session(       readExtension     , extensionImplications@@ -14,37 +14,50 @@     , parsePragmasIntoDynFlags   ) where -#if defined (GHC_8_8) || defined (GHC_8_10)+#if defined (GHC_8_8) import qualified GHC.LanguageExtensions as LangExt-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)+import Panic+import HeaderInfo+import StringBuffer+import DynFlags+import HscTypes+#elif defined (GHC_8_10)+import qualified GHC.LanguageExtensions as LangExt+import Panic+import HeaderInfo+import StringBuffer+import DynFlags+import HscTypes+#elif defined (GHC_9_0) import GHC.Utils.Panic import GHC.Parser.Header import GHC.Data.StringBuffer import GHC.Driver.Session-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)-import GHC.Types.SourceError-#else import GHC.Driver.Types-#endif #else-import Panic-import HeaderInfo-import StringBuffer-import DynFlags-import HscTypes+import GHC.Utils.Panic+import GHC.Parser.Header+import GHC.Data.StringBuffer+import GHC.Driver.Session+import GHC.Types.SourceError #endif import GHC.LanguageExtensions.Type import Data.List import Data.Maybe import qualified Data.Map as Map++#if defined (GHC_9_12) || defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8)+#else+import GHC.Utils.Logger+#endif+ -- Landed in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707. #if defined (GHC_8_8) || defined (GHC_8_10) import Data.Function -- For `compareOn`. instance Ord Extension where   compare = compare `on` fromEnum #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if ! (defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined(GHC_8_8) ) import GHC.Driver.Config.Parser #endif @@ -52,6 +65,7 @@ readExtension :: String -> Maybe Extension readExtension s = flagSpecFlag <$> find (\(FlagSpec n _ _ _) -> n == s) xFlags +#if (defined (GHC_9_12) || defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined(GHC_8_8) ) -- | Implicitly enabled/disabled extensions. extensionImplications :: [(Extension, ([Extension], [Extension]))] extensionImplications = map f $ Map.toList implicationsMap@@ -60,8 +74,28 @@     implicationsMap :: Map.Map String ([Extension], [Extension])     implicationsMap = Map.fromListWith (<>)       [(show a, ([c | b], [c | not b]))-        | (a, flag, c) <- impliedXFlags, let b = flag == turnOn]+        | (a, flag, c) <- impliedXFlags,+          let b = flag == turnOn+      ]+#else+  {- defined (GHC_9_14) -}+-- | Implicitly enabled/disabled extensions.+extensionImplications :: [(Extension, ([Extension], [Extension]))]+extensionImplications = map f $ Map.toList implicationsMap+  where+    f (e, ps) = (fromJust (readExtension e), ps)+    implicationsMap :: Map.Map String ([Extension], [Extension])+    implicationsMap = Map.fromListWith (<>)+      [(show a, ([strip c | b], [strip c | not b]))+        | (a, c) <- impliedXFlags,+          let b = case c of On _ -> True; Off _ -> False+      ] +    strip :: OnOff a -> a+    strip (On e) = e+    strip (Off e) = e+#endif+ -- Landed in -- https://gitlab.haskell.org/ghc/ghc/merge_requests/2654. Copied from -- 'ghc/compiler/main/DynFlags.hs'.@@ -161,19 +195,25 @@                          -> IO (Either String DynFlags) parsePragmasIntoDynFlags flags (enable, disable) file str =   catchErrors $ do-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)-    let (_, opts) =-          getOptions (initParserOpts flags) (stringToStringBuffer str) file+#if (defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+    let opts = getOptions flags (stringToStringBuffer str) file+#elif (defined (GHC_9_12) || defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4))+    let (_, opts) = getOptions (initParserOpts flags) (stringToStringBuffer str) file+#elif (defined (GHC_9_14))+    let (_, opts) = getOptions (initParserOpts flags) (supportedLanguagePragmas flags) (stringToStringBuffer str) file #else-    let opts =-          getOptions flags (stringToStringBuffer str) file+    let (_, opts) = getOptions (initParserOpts flags) (initSourceErrorContext flags) (supportedLanguagePragmas flags) (stringToStringBuffer str) file #endif-     -- Important : apply enables, disables *before* parsing dynamic     -- file pragmas.     let flags' =  foldl' xopt_set flags enable     let flags'' = foldl' xopt_unset flags' disable+#if defined (GHC_9_12) || defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8)     (flags, _, _) <- parseDynamicFilePragma flags'' opts+#else+    logger <- initLogger+    (flags, _, _) <- parseDynamicFilePragma logger flags'' opts+#endif     return $ Right (flags `gopt_set` Opt_KeepRawTokenStream)   where     catchErrors :: IO (Either String DynFlags) -> IO (Either String DynFlags)
src/Language/Haskell/GhclibParserEx/GHC/Hs.hs view
@@ -1,27 +1,27 @@--- Copyright (c) 2020, Shayne Fletcher. All rights reserved.+-- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. -{-# LANGUAGE CPP #-} #include "ghclib_api.h"-module Language.Haskell.GhclibParserEx.GHC.Hs(-   modName- )+module Language.Haskell.GhclibParserEx.GHC.Hs+  ( modName,+  ) where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0)-import GHC.Hs-#  if !defined (GHC_9_10) && !defined (GHC_9_8) && !defined (GHC_9_6)-import GHC.Unit.Module-#  endif-import GHC.Types.SrcLoc+#if defined (GHC_8_8)+import HsSyn+import Module+import SrcLoc #elif defined (GHC_8_10) import GHC.Hs import Module import SrcLoc+#elif defined (GHC_9_0) || defined (GHC_9_2) || defined (GHC_9_4)+import GHC.Hs+import GHC.Unit.Module+import GHC.Types.SrcLoc #else-import HsSyn-import Module-import SrcLoc+import GHC.Hs+import GHC.Types.SrcLoc #endif  #if defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0)@@ -29,5 +29,5 @@ #else modName :: Located (HsModule GhcPs) -> String #endif-modName (L _ HsModule {hsmodName=Nothing}) = "Main"-modName (L _ HsModule {hsmodName=Just (L _ n)}) = moduleNameString n+modName (L _ HsModule {hsmodName = Nothing}) = "Main"+modName (L _ HsModule {hsmodName = Just (L _ n)}) = moduleNameString n
src/Language/Haskell/GhclibParserEx/GHC/Hs/Binds.hs view
@@ -1,20 +1,20 @@--- Copyright (c) 2020-203, Shayne Fletcher. All rights reserved.+-- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause.-{-# LANGUAGE CPP #-}+ #include "ghclib_api.h"-module Language.Haskell.GhclibParserEx.GHC.Hs.Binds(-  isPatSynBind+module Language.Haskell.GhclibParserEx.GHC.Hs.Binds+  ( isPatSynBind,   ) where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-import GHC.Hs.Binds-import GHC.Hs.Extension-#else+#if defined (GHC_8_8) import HsBinds import HsExtension+#else+import GHC.Hs.Binds+import GHC.Hs.Extension #endif  isPatSynBind :: HsBind GhcPs -> Bool-isPatSynBind PatSynBind{} = True+isPatSynBind PatSynBind {} = True isPatSynBind _ = False
src/Language/Haskell/GhclibParserEx/GHC/Hs/Decls.hs view
@@ -1,21 +1,24 @@ -- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. -{-# LANGUAGE CPP #-} #include "ghclib_api.h"-module Language.Haskell.GhclibParserEx.GHC.Hs.Decls(-    isNewType, isForD, isDerivD, isClsDefSig-  ) where+module Language.Haskell.GhclibParserEx.GHC.Hs.Decls+  ( isNewType,+    isForD,+    isDerivD,+    isClsDefSig,+  )+where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-import GHC.Hs-#else+#if defined(GHC_8_8) import HsSyn-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)-import GHC.Types.SrcLoc #else+import GHC.Hs+#endif+#if defined (GHC_8_10) || defined (GHC_8_8) import SrcLoc+#else+import GHC.Types.SrcLoc #endif  isNewType :: NewOrData -> Bool@@ -23,8 +26,8 @@ isNewType DataType = False  isForD, isDerivD :: LHsDecl GhcPs -> Bool-isForD (L _ ForD{}) = True; isForD _ = False-isDerivD (L _ DerivD{}) = True; isDerivD _ = False+isForD (L _ ForD {}) = True; isForD _ = False+isDerivD (L _ DerivD {}) = True; isDerivD _ = False  isClsDefSig :: Sig GhcPs -> Bool isClsDefSig (ClassOpSig _ True _ _) = True; isClsDefSig _ = False
+ src/Language/Haskell/GhclibParserEx/GHC/Hs/Dump.hs view
@@ -0,0 +1,241 @@+-- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved.+-- SPDX-License-Identifier: BSD-3-Clause.+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}+{- ORMOLU_DISABLE -}+{- HLINT ignore -} -- Not our code.+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+#include "ghclib_api.h"+module Language.Haskell.GhclibParserEx.GHC.Hs.Dump(+    showAstData+  , BlankSrcSpan(..)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+  , BlankEpAnnotations(..)+#endif+) where++#if !defined(MIN_VERSION_ghc_lib_parser)+-- Pay attenion: This is the native GHC case.++#  if defined (GHC_8_8)+import HsDumpAst+#  else+import GHC.Hs.Dump+#  endif++#else+-- Once again, attenion please. This is the ghc-lib-parser case.++#  if !defined (GHC_8_8)+import GHC.Hs.Dump+#  else+-- In the 8.8 case reproduce the implementation (the original ended up+-- in ghc-lib).++import Prelude as X hiding ((<>))++import Data.Data hiding (Fixity)+import Bag+import BasicTypes+import FastString+import NameSet+import Name+import DataCon+import SrcLoc+import HsSyn+import OccName hiding (occName)+import Var+import Module+import Outputable++import qualified Data.ByteString as B++data BlankSrcSpan = BlankSrcSpan | NoBlankSrcSpan+                  deriving (Eq,Show)++-- | Show a GHC syntax tree. This parameterised because it is also used for+-- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked+-- out, to avoid comparing locations, only structure+showAstData :: Data a => BlankSrcSpan -> a -> SDoc+showAstData b a0 = blankLine $$ showAstData' a0+  where+    showAstData' :: Data a => a -> SDoc+    showAstData' =+      generic+              `ext1Q` list+              `extQ` string `extQ` fastString `extQ` srcSpan+              `extQ` lit `extQ` litr `extQ` litt+              `extQ` bytestring+              `extQ` name `extQ` occName `extQ` moduleName `extQ` var+              `extQ` dataCon+              `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet+              `extQ` fixity+              `ext2Q` located++      where generic :: Data a => a -> SDoc+            generic t = parens $ text (showConstr (toConstr t))+                                  $$ vcat (gmapQ showAstData' t)++            string :: String -> SDoc+            string     = text . normalize_newlines . show++            fastString :: FastString -> SDoc+            fastString s = braces $+                            text "FastString: "+                         <> text (normalize_newlines . show $ s)++            bytestring :: B.ByteString -> SDoc+            bytestring = text . normalize_newlines . show++            list []    = brackets empty+            list [x]   = brackets (showAstData' x)+            list (x1 : x2 : xs) =  (text "[" <> showAstData' x1)+                                $$ go x2 xs+              where+                go y [] = text "," <> showAstData' y <> text "]"+                go y1 (y2 : ys) = (text "," <> showAstData' y1) $$ go y2 ys++            -- Eliminate word-size dependence+            lit :: HsLit GhcPs -> SDoc+            lit (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            lit (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            lit (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            lit l                  = generic l++            litr :: HsLit GhcRn -> SDoc+            litr (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            litr (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            litr (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            litr l                  = generic l++            litt :: HsLit GhcTc -> SDoc+            litt (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            litt (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            litt (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            litt l                  = generic l++            numericLit :: String -> Integer -> SourceText -> SDoc+            numericLit tag x s = braces $ hsep [ text tag+                                               , generic x+                                               , generic s ]++            name :: Name -> SDoc+            name nm    = braces $ text "Name: " <> ppr nm++            occName n  =  braces $+                          text "OccName: "+                       <> text (OccName.occNameString n)++            moduleName :: ModuleName -> SDoc+            moduleName m = braces $ text "ModuleName: " <> ppr m++            srcSpan :: SrcSpan -> SDoc+            srcSpan ss = case b of+             BlankSrcSpan -> text "{ ss }"+             NoBlankSrcSpan -> braces $ char ' ' <>+                             (hang (ppr ss) 1+                                   -- TODO: show annotations here+                                   (text ""))++            var  :: Var -> SDoc+            var v      = braces $ text "Var: " <> ppr v++            dataCon :: DataCon -> SDoc+            dataCon c  = braces $ text "DataCon: " <> ppr c++            bagRdrName:: Bag (Located (HsBind GhcPs)) -> SDoc+            bagRdrName bg =  braces $+                             text "Bag(Located (HsBind GhcPs)):"+                          $$ (list . bagToList $ bg)++            bagName   :: Bag (Located (HsBind GhcRn)) -> SDoc+            bagName bg  =  braces $+                           text "Bag(Located (HsBind Name)):"+                        $$ (list . bagToList $ bg)++            bagVar    :: Bag (Located (HsBind GhcTc)) -> SDoc+            bagVar bg  =  braces $+                          text "Bag(Located (HsBind Var)):"+                       $$ (list . bagToList $ bg)++            nameSet ns =  braces $+                          text "NameSet:"+                       $$ (list . nameSetElemsStable $ ns)++            fixity :: Fixity -> SDoc+            fixity fx =  braces $+                         text "Fixity: "+                      <> ppr fx++            located :: (Data b,Data loc) => GenLocated loc b -> SDoc+            located (L ss a) = parens $+                   case cast ss of+                        Just (s :: SrcSpan) ->+                          srcSpan s+                        Nothing -> text "nnnnnnnn"+                      $$ showAstData' a++normalize_newlines :: String -> String+normalize_newlines ('\\':'r':'\\':'n':xs) = '\\':'n':normalize_newlines xs+normalize_newlines (x:xs)                 = x:normalize_newlines xs+normalize_newlines []                     = []++{-+************************************************************************+*                                                                      *+* Copied from syb+*                                                                      *+************************************************************************+-}+++-- | The type constructor for queries+newtype Q q x = Q { unQ :: x -> q }++-- | Extend a generic query by a type-specific case+extQ :: ( Typeable a+        , Typeable b+        )+     => (a -> q)+     -> (b -> q)+     -> a+     -> q+extQ f g a = maybe (f a) g (cast a)++-- | Type extension of queries for type constructors+ext1Q :: (Data d, Typeable t)+      => (d -> q)+      -> (forall e. Data e => t e -> q)+      -> d -> q+ext1Q def ext = unQ ((Q def) `ext1` (Q ext))+++-- | Type extension of queries for type constructors+ext2Q :: (Data d, Typeable t)+      => (d -> q)+      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)+      -> d -> q+ext2Q def ext = unQ ((Q def) `ext2` (Q ext))++-- | Flexible type extension+ext1 :: (Data a, Typeable t)+     => c a+     -> (forall d. Data d => c (t d))+     -> c a+ext1 def ext = maybe def id (dataCast1 ext)++-- | Flexible type extension+ext2 :: (Data a, Typeable t)+     => c a+     -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))+     -> c a+ext2 def ext = maybe def id (dataCast2 ext)+#  endif+#endif
src/Language/Haskell/GhclibParserEx/GHC/Hs/Expr.hs view
@@ -1,8 +1,8 @@--- Copyright (c) 2020, Shayne Fletcher. All rights reserved.+-- Copyright (c) 2020-2024, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. +{- ORMOLU_DISABLE -} {-# OPTIONS_GHC -Wno-missing-fields #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Hs.Expr(@@ -11,7 +11,7 @@   isDotApp, isTypeApp, isWHNF, isLCase,   isFieldPun, isFieldPunUpdate, isRecStmt, isLetStmt, isParComp, isMDo, isListComp, isMonadComp, isTupleSection, isString, isPrimLiteral,   isSpliceDecl,-#if !( defined(GHC_8_8) || defined(GHC_8_10) || defined (GHC_9_0) || defined (GHC_9_2) || defined(GHC_9_4) )+#if !( defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )   -- ghc api >= 9.6.1   isTypedSplice, isUntypedSplice, #endif@@ -21,30 +21,46 @@   fromChar   ) where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-import GHC.Hs-#else+#if defined (GHC_8_8) import HsSyn-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+import SrcLoc+import RdrName+import OccName+import Name+import BasicTypes+import TysWiredIn+#elif defined (GHC_8_10)+import GHC.Hs+import SrcLoc+import RdrName+import OccName+import Name+import BasicTypes+import TysWiredIn+#elif defined (GHC_9_0)+import GHC.Hs+import GHC.Types.SrcLoc+import GHC.Types.Name.Reader+import GHC.Types.Name+import GHC.Types.Basic+import GHC.Builtin.Types+#elif defined (GHC_9_2) || defined (GHC_9_4)+import GHC.Hs import GHC.Types.SourceText-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6)-import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader-#endif import GHC.Types.SrcLoc import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Types.Basic import GHC.Builtin.Types #else-import SrcLoc-import RdrName-import OccName-import Name-import BasicTypes-import TysWiredIn+import GHC.Hs+import GHC.Types.SourceText+import GHC.Types.SrcLoc+import GHC.Types.Name.Reader+import GHC.Types.Name+import GHC.Types.Basic+import GHC.Builtin.Types+import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader #endif import Data.Ratio @@ -68,10 +84,18 @@ isAnyApp x = isApp x || isOpApp x isDo = \case (L _ HsDo{}) -> True; _ -> False isLexeme = \case (L _ HsVar{}) -> True; (L _ HsOverLit{}) -> True; (L _ HsLit{}) -> True; _ -> False+-- 'isLambda' semantics are match form `\p -> e` exclusively+#if ! ( defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+--ghc api >= 9.8.1+isLambda = \case (L _ (HsLam _ LamSingle _)) -> True; _ -> False+#else isLambda = \case (L _ HsLam{}) -> True; _ -> False-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6)+#endif+#if ! ( defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.6.1 isQuasiQuoteExpr = \case (L _ (HsUntypedSplice _ HsQuasiQuote{})) -> True; _ -> False #else+-- ghc api < 9.6.1 isQuasiQuoteExpr = \case (L _ (HsSpliceE _ HsQuasiQuote{})) -> True; _ -> False #endif isQuasiQuote = isQuasiQuoteExpr -- Backwards compat.@@ -79,11 +103,21 @@ isTypeApp = \case (L _ HsAppType{}) -> True; _ -> False isWHNF = \case   (L _ (HsVar _ (L _ x))) -> isRdrDataCon x+#if ! ( defined(GHC_9_12) || defined (GHC_9_10) || defined (GHC_9_8) || defined(GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api > 9.12.1+  (L _ (HsLit _ x)) -> case x of HsString{} -> False; _ -> True+#else   (L _ (HsLit _ x)) -> case x of HsString{} -> False; HsInt{} -> False; HsRat{} -> False; _ -> True+#endif   (L _ HsLam{}) -> True   (L _ ExplicitTuple{}) -> True   (L _ ExplicitList{}) -> True-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)++#if ! ( defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.8+  (L _ (HsPar _  x )) -> isWHNF x+#elif ! ( defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.4   (L _ (HsPar _ _ x _)) -> isWHNF x #else   (L _ (HsPar _ x)) -> isWHNF x@@ -94,26 +128,34 @@   (L _ (HsApp _ (L _ (HsVar _ (L _ x))) _))     | occNameString (rdrNameOcc x) `elem` ["Just", "Left", "Right"] -> True   _ -> False+#if ! ( defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+isLCase = \case (L _ (HsLam _ LamCase _)) -> True; (L _ (HsLam _ LamCases _)) -> True; _ -> False+#else isLCase = \case (L _ HsLamCase{}) -> True; _ -> False+#endif isOverLabel = \case (L _ HsOverLabel{}) -> True; _ -> False -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6)+#if ! ( defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.6.1 isQuasiQuoteSplice :: HsUntypedSplice GhcPs -> Bool #else isQuasiQuoteSplice :: HsSplice GhcPs -> Bool #endif isQuasiQuoteSplice = \case HsQuasiQuote{} -> True; _ -> False --#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHCLIB_API_901)+#if ( defined (GHC_8_10) || defined (GHC_8_8) )+isStrictMatch :: HsMatchContext RdrName -> Bool+#elif ( defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) ) isStrictMatch :: HsMatchContext GhcPs -> Bool #else-isStrictMatch :: HsMatchContext RdrName -> Bool+-- ghc > 9.8.1+isStrictMatch :: HsMatchContext (LocatedN RdrName) -> Bool #endif isStrictMatch = \case FunRhs{mc_strictness=SrcStrict} -> True; _ -> False  -- Field is punned e.g. '{foo}'.-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if ! ( defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.4.1 isFieldPun :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool isFieldPun = \case (L _ HsFieldBind {hfbPun=True}) -> True; _ -> False #else@@ -122,7 +164,12 @@ #endif -- Field puns in updates have a different type to field puns in -- constructions.-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if ! ( defined (GHC_9_10) || defined (GHC_9_8) || defined(GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api > 9.10.1+isFieldPunUpdate :: HsFieldBind (LFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool+isFieldPunUpdate = \case HsFieldBind {hfbPun=True} -> True; _ -> False+#elif ! ( defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.4.1 && <= 9.12.1 isFieldPunUpdate :: HsFieldBind (LAmbiguousFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool isFieldPunUpdate = \case HsFieldBind {hfbPun=True} -> True; _ -> False #else@@ -144,14 +191,15 @@ isParComp = \case ParStmt{} -> True; _ -> False  -- TODO: Seems `HsStmtContext (HsDoRn p)` on master right now.-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if ! ( defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.4.1 isMDo :: HsDoFlavour -> Bool isMDo = \case MDoExpr _ -> True; _ -> False isMonadComp :: HsDoFlavour -> Bool isMonadComp = \case MonadComp -> True; _ -> False isListComp :: HsDoFlavour -> Bool isListComp = \case ListComp -> True; _ -> False-#elif defined(GHC_9_2) || defined (GHC_9_0)+#elif defined (GHC_9_2) || defined (GHC_9_0) isMDo :: HsStmtContext GhcRn -> Bool isMDo = \case MDoExpr _ -> True; _ -> False isMonadComp :: HsStmtContext GhcRn -> Bool@@ -187,14 +235,16 @@  -- Since ghc-9.6.1, `HsTypedSplice` and `HsUntypedSplice` have been -- top-level constuctors of `Language.Haskell.Syntax.Expr.HsExpr p`-#if !( defined(GHC_8_8) || defined(GHC_8_10) || defined (GHC_9_0) || defined (GHC_9_2) || defined(GHC_9_4) )+#if ! ( defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= ghc-9.6.1 isTypedSplice, isUntypedSplice :: HsExpr GhcPs -> Bool isTypedSplice = \case HsTypedSplice{} -> True; _ -> False isUntypedSplice = \case HsUntypedSplice{} -> True; _ -> False #endif  isSpliceDecl :: HsExpr GhcPs -> Bool-#if !( defined(GHC_8_8) || defined(GHC_8_10) || defined (GHC_9_0) || defined (GHC_9_2) || defined(GHC_9_4) )+#if ! ( defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.6.1 isSpliceDecl = \case   HsTypedSplice{} -> True   HsUntypedSplice{} -> True@@ -213,30 +263,41 @@ isTransStmt = \case TransStmt{} -> True; _ -> False  -- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'.-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)-isFieldWildcard :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool-#else+#if defined (GHC_8_8) || defined (GHC_8_10) || defined (GHC_9_0) || defined (GHC_9_2) isFieldWildcard :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool+#else+-- ghc api >= 9.4.1+isFieldWildcard :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool #endif isFieldWildcard = \case-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6)--- Use `Language.Haskell.GhcLibParserEx.GHC.Types.Name.Reader`s `occNameStr` since `HsUnboundVar` now contains a `RdrName` not an `OccName`.-  (L _ HsFieldBind {hfbRHS=(L _ (HsUnboundVar _ s))}) -> occNameStr s == "_"-#elif defined (GHC_9_4)-  (L _ HsFieldBind {hfbRHS=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_"-#elif defined(GHC_9_2) || defined (GHC_9_0)-  (L _ HsRecField {hsRecFieldArg=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_"+#if defined (GHC_8_8)+  (L _ HsRecField {hsRecFieldArg=(L _ (EWildPat _))}) -> True+  (L _ HsRecField {hsRecPun=True}) -> True+  (L _ HsRecField {}) -> False #elif defined (GHC_8_10)   (L _ HsRecField {hsRecFieldArg=(L _ (HsUnboundVar _ _))}) -> True-#else-  (L _ HsRecField {hsRecFieldArg=(L _ (EWildPat _))}) -> True-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+  (L _ HsRecField {hsRecPun=True}) -> True+  (L _ HsRecField {}) -> False+#elif defined (GHC_9_2) || defined (GHC_9_0)+  (L _ HsRecField {hsRecFieldArg=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_"+  (L _ HsRecField {hsRecPun=True}) -> True+  (L _ HsRecField {}) -> False+#elif defined (GHC_9_4)+  (L _ HsFieldBind {hfbRHS=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_"   (L _ HsFieldBind {hfbPun=True}) -> True   (L _ HsFieldBind {}) -> False+#elif defined(GHC_9_12) || defined(GHC_9_10) || defined (GHC_9_8) || defined(GHC_9_6)+-- ghc api >= ghc-9.6.1+-- Use `Language.Haskell.GhcLibParserEx.GHC.Types.Name.Reader`s `occNameStr` since `HsUnboundVar` now contains a `RdrName` not an `OccName`.+  (L _ HsFieldBind {hfbRHS=(L _ (HsUnboundVar _ s))}) -> occNameStr s == "_"+  (L _ HsFieldBind {hfbPun=True}) -> True+  (L _ HsFieldBind {}) -> False #else-  (L _ HsRecField {hsRecPun=True}) -> True-  (L _ HsRecField {}) -> False+-- ghc api > ghc-9.12+-- Use `Language.Haskell.GhcLibParserEx.GHC.Types.Name.Reader`s `occNameStr`. `HsHoleVar` has a `RdrName` not an `OccName`.+  (L _ HsFieldBind {hfbRHS=(L _ (HsHole(HoleVar(L _ s))))}) -> occNameStr s == "_"+  (L _ HsFieldBind {hfbPun=True}) -> True+  (L _ HsFieldBind {}) -> False #endif  isUnboxed :: Boxity -> Bool@@ -244,10 +305,14 @@  isWholeFrac :: HsExpr GhcPs -> Bool -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if ! ( defined(GHC_9_12) || defined (GHC_9_10) || defined (GHC_9_8) || defined(GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api > 9.12.1+isWholeFrac (HsOverLit _ (OverLit _ (HsFractional fl@FL {}) )) = denominator (rationalFromFractionalLit fl) == 1+#elif ! (defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.4.1 isWholeFrac (HsLit _ (HsRat _ fl@FL{} _)) = denominator (rationalFromFractionalLit fl) == 1 isWholeFrac (HsOverLit _ (OverLit _ (HsFractional fl@FL {}) )) = denominator (rationalFromFractionalLit fl) == 1-#elif defined(GHC_9_2)+#elif defined (GHC_9_2) isWholeFrac (HsLit _ (HsRat _ fl@FL{} _)) = denominator (rationalFromFractionalLit fl) == 1 isWholeFrac (HsOverLit _ (OverLit _ (HsFractional fl@FL {}) _)) = denominator (rationalFromFractionalLit fl) == 1 #else@@ -265,7 +330,8 @@ varToStr _ = ""  strToVar :: String -> LHsExpr GhcPs-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! ( defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc api >= 9.2.1 strToVar x = noLocA $ HsVar noExtField (noLocA $ mkRdrUnqual (mkVarOcc x)) #elif defined (GHC_9_0) || defined (GHC_8_10) strToVar x = noLoc $ HsVar noExtField (noLoc $ mkRdrUnqual (mkVarOcc x))
src/Language/Haskell/GhclibParserEx/GHC/Hs/ExtendInstances.hs view
@@ -1,8 +1,8 @@ -- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. +{- ORMOLU_DISABLE -} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE CPP #-} #include "ghclib_api.h"  module Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances (@@ -18,14 +18,14 @@ -- representations rather than the terms themselves, leads to -- identical results. -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)+#if !( defined (GHC_8_8) || defined (GHC_8_10)) import GHC.Utils.Outputable #else import Outputable #endif import Data.Data import Data.Function-import Language.Haskell.GhclibParserEx.Dump+import Language.Haskell.GhclibParserEx.GHC.Hs.Dump  newtype HsExtendInstances a =   HsExtendInstances { unextendInstances :: a }@@ -39,7 +39,7 @@ -- string representations. toStr :: Data a => HsExtendInstances a -> String toStr (HsExtendInstances e) =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)+#if !( defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )   showPprUnsafe $ showAstData BlankSrcSpan BlankEpAnnotations e #else   showSDocUnsafe $ showAstData BlankSrcSpan e@@ -57,7 +57,7 @@ -- Use 'ppr' for 'Show'. instance Outputable a => Show (HsExtendInstances a) where   show (HsExtendInstances e) =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined(GHC_9_6) || defined(GHC_9_2)+#if !( defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )     showPprUnsafe $ ppr e #else     showSDocUnsafe $ ppr e
src/Language/Haskell/GhclibParserEx/GHC/Hs/ImpExp.hs view
@@ -1,6 +1,7 @@ -- Copyright (c) 2020-2023 Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause.-{-# LANGUAGE CPP #-}++{- ORMOLU_DISABLE -} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Hs.ImpExp(     isPatSynIE@@ -14,24 +15,21 @@   ) where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6)-import GHC.Hs.Extension (GhcPs)-#endif--#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)-import GHC.Hs.ImpExp-#  if !defined (GHC_9_10) && !defined (GHC_9_8) && !defined (GHC_9_6)-import GHC.Types.Name.Reader-#  endif+#if defined (GHC_8_8)+import HsImpExp+import RdrName #elif defined (GHC_8_10) import GHC.Hs.ImpExp import RdrName+#elif defined (GHC_9_0) || defined (GHC_9_2) || defined (GHC_9_4)+import GHC.Hs.ImpExp+import GHC.Types.Name.Reader #else-import HsImpExp-import RdrName+import GHC.Hs.ImpExp+import GHC.Hs.Extension (GhcPs) #endif -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6)+#if !( defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) isPatSynIE :: IEWrappedName GhcPs -> Bool #else isPatSynIE :: IEWrappedName RdrName -> Bool
src/Language/Haskell/GhclibParserEx/GHC/Hs/Pat.hs view
@@ -1,178 +1,181 @@ -- Copyright (c) 2020-203, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause.--{-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} #include "ghclib_api.h"-module Language.Haskell.GhclibParserEx.GHC.Hs.Pat(-    patToStr, strToPat-  , fromPChar-  , hasPFieldsDotDot-  , isPFieldWildcard, isPWildcard, isPFieldPun, isPatTypeSig, isPBangPat, isPViewPat-  , isSplicePat- ) where+module Language.Haskell.GhclibParserEx.GHC.Hs.Pat+  ( patToStr,+    strToPat,+    fromPChar,+    hasPFieldsDotDot,+    isPFieldWildcard,+    isPWildcard,+    isPFieldPun,+    isPatTypeSig,+    isPBangPat,+    isPViewPat,+    isWildPat {- alias for 'isPWildcard' -},+    isSplicePat,+  )+where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)+#if defined (GHC_8_8)+import HsSyn+import SrcLoc+import TysWiredIn+import RdrName+import OccName+import FastString+#elif defined (GHC_8_10) import GHC.Hs+import SrcLoc+import TysWiredIn+import RdrName+import OccName+import FastString #else-import HsSyn-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0)+import GHC.Hs import GHC.Types.SrcLoc import GHC.Builtin.Types import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Data.FastString-#else-import SrcLoc-import TysWiredIn-import RdrName-import OccName-import FastString #endif  patToStr :: LPat GhcPs -> String-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)-patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "True" = "True"-patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "False" = "False"-patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "[]" = "[]"+#if defined (GHC_8_8)+patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"+patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"+patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]" patToStr _ = ""+#elif defined (GHC_8_10)+patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"+patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"+patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]"+patToStr _ = "" #elif defined (GHC_9_0) patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True" patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False" patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]" patToStr _ = ""-#elif defined (GHC_8_10)-patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"-patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"-patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]"+#elif defined (GHC_9_2) || defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12)+patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "True" = "True"+patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "False" = "False"+patToStr (L _ (ConPat _ (L _ x) (PrefixCon [] []))) | occNameString (rdrNameOcc x) == "[]" = "[]" patToStr _ = "" #else-patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"-patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"-patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]"+patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"+patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"+patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]" patToStr _ = "" #endif  strToPat :: String -> LPat GhcPs+ strToPat z-  | z == "True"  =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)-  noLocA $-#elif defined (GHC_9_0) || defined (GHC_8_10)-  noLoc $-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)-    ConPat noAnn (noLocA true_RDR) (PrefixCon [] [])-#elif defined (GHC_9_0)-    ConPat noExtField (noLoc true_RDR) (PrefixCon [])-#else-    ConPatIn (noLoc true_RDR) (PrefixCon [])-#endif-  | z == "False" =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)-  noLocA $-#elif defined (GHC_9_0) || defined (GHC_8_10)-  noLoc $-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)-    ConPat noAnn (noLocA false_RDR) (PrefixCon [] [])-#elif defined (GHC_9_0)-    ConPat noExtField (noLoc false_RDR) (PrefixCon [])-#else-    ConPatIn (noLoc false_RDR) (PrefixCon [])-#endif-  | z == "[]"    =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)-  noLocA $-#elif defined (GHC_9_0) || defined (GHC_8_10)-  noLoc $-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)-    ConPat noAnn (noLocA $ nameRdrName nilDataConName) (PrefixCon [] [])+#if defined (GHC_8_8)+  | z == "True" = ConPatIn (noLoc true_RDR) (PrefixCon [])+  | z == "False" = ConPatIn (noLoc false_RDR) (PrefixCon [])+  | z == "[]" = ConPatIn (noLoc $ nameRdrName nilDataConName) (PrefixCon [])+  | otherwise = VarPat noExt (noLoc $ mkVarUnqual (fsLit z))+#elif defined (GHC_8_10)+  | z == "True" =  noLoc $ ConPatIn (noLoc true_RDR) (PrefixCon [])+  | z == "False" =  noLoc $ ConPatIn (noLoc false_RDR) (PrefixCon [])+  | z == "[]" = noLoc $ ConPatIn (noLoc $ nameRdrName nilDataConName) (PrefixCon [])+  | otherwise = noLoc $ VarPat noExtField (noLoc $ mkVarUnqual (fsLit z)) #elif defined (GHC_9_0)-    ConPat noExtField (noLoc $ nameRdrName nilDataConName) (PrefixCon [])-#else-    ConPatIn (noLoc $ nameRdrName nilDataConName) (PrefixCon [])-#endif-  | otherwise =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)-      noLocA $ VarPat noExtField (noLocA $ mkVarUnqual (fsLit z))-#elif defined (GHC_9_0) || defined (GHC_8_10)-      noLoc $ VarPat noExtField (noLoc $ mkVarUnqual (fsLit z))+  | z == "True" = noLoc $ ConPat noExtField (noLoc true_RDR) (PrefixCon [])+  | z == "False" = noLoc $ ConPat noExtField (noLoc false_RDR) (PrefixCon [])+  | z == "[]" = noLoc $ ConPat noExtField (noLoc $ nameRdrName nilDataConName) (PrefixCon [])+  | otherwise = noLoc $ VarPat noExtField (noLoc $ mkVarUnqual (fsLit z))+#elif defined (GHC_9_2) || defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12)+  | z == "True" = noLocA $ ConPat noAnn (noLocA true_RDR) (PrefixCon [] [])+  | z == "False" = noLocA $ ConPat noAnn (noLocA false_RDR) (PrefixCon [] [])+  | z == "[]" = noLocA $ ConPat noAnn (noLocA $ nameRdrName nilDataConName) (PrefixCon [] [])+  | otherwise = noLocA $ VarPat noExtField (noLocA $ mkVarUnqual (fsLit z)) #else-      VarPat noExt (noLoc $ mkVarUnqual (fsLit z))+  | z == "True" = noLocA $ ConPat noAnn (noLocA true_RDR) (PrefixCon [])+  | z == "False" = noLocA $ ConPat noAnn (noLocA false_RDR) (PrefixCon [])+  | z == "[]" = noLocA $ ConPat noAnn (noLocA $ nameRdrName nilDataConName) (PrefixCon [])+  | otherwise = noLocA $ VarPat noExtField (noLocA $ mkVarUnqual (fsLit z)) #endif  fromPChar :: LPat GhcPs -> Maybe Char-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-fromPChar (L _ (LitPat _ (HsChar _ x))) = Just x-#else+#if defined (GHC_8_8) fromPChar (dL -> L _ (LitPat _ (HsChar _ x))) = Just x+#else+fromPChar (L _ (LitPat _ (HsChar _ x))) = Just x #endif fromPChar _ = Nothing  -- Contains a '..' as in 'Foo{..}' hasPFieldsDotDot :: HsRecFields GhcPs (LPat GhcPs) -> Bool-hasPFieldsDotDot HsRecFields {rec_dotdot=Just _} = True+hasPFieldsDotDot HsRecFields {rec_dotdot = Just _} = True hasPFieldsDotDot _ = False  -- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'.-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if !( defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc >= 9.4 isPFieldWildcard :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool #else isPFieldWildcard :: LHsRecField GhcPs (LPat GhcPs) -> Bool #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)-isPFieldWildcard (L _ HsFieldBind {hfbRHS=L _ WildPat {}}) = True-isPFieldWildcard (L _ HsFieldBind {hfbPun=True}) = True-isPFieldWildcard (L _ HsFieldBind {}) = False-#elif defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)+#if defined (GHC_8_8)+isPFieldWildcard (dL -> L _ HsRecField {hsRecFieldArg=LL _ WildPat {}}) = True+isPFieldWildcard (dL -> L _ HsRecField {hsRecPun=True}) = True+isPFieldWildcard (dL -> L _ HsRecField {}) = False+#elif defined (GHC_8_10) isPFieldWildcard (L _ HsRecField {hsRecFieldArg=L _ WildPat {}}) = True isPFieldWildcard (L _ HsRecField {hsRecPun=True}) = True isPFieldWildcard (L _ HsRecField {}) = False+#elif defined (GHC_9_0) || defined (GHC_9_2)+isPFieldWildcard (L _ HsRecField {hsRecFieldArg=L _ WildPat {}}) = True+isPFieldWildcard (L _ HsRecField {hsRecPun=True}) = True+isPFieldWildcard (L _ HsRecField {}) = False #else-isPFieldWildcard (dL -> L _ HsRecField {hsRecFieldArg=LL _ WildPat {}}) = True-isPFieldWildcard (dL -> L _ HsRecField {hsRecPun=True}) = True-isPFieldWildcard (dL -> L _ HsRecField {}) = False+isPFieldWildcard (L _ HsFieldBind {hfbRHS=L _ WildPat {}}) = True+isPFieldWildcard (L _ HsFieldBind {hfbPun=True}) = True+isPFieldWildcard (L _ HsFieldBind {}) = False #endif  isPWildcard :: LPat GhcPs -> Bool-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-isPWildcard (L _ (WildPat _)) = True-#else+#if defined (GHC_8_8) isPWildcard (dL -> L _ (WildPat _)) = True+#else+isPWildcard (L _ (WildPat _)) = True #endif isPWildcard _ = False -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+isWildPat :: LPat GhcPs -> Bool+isWildPat = isPWildcard++#if !( defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) isPFieldPun :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool #else isPFieldPun :: LHsRecField GhcPs (LPat GhcPs) -> Bool #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)-isPFieldPun (L _ HsFieldBind {hfbPun=True}) = True-#elif defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)+#if defined (GHC_8_8)+isPFieldPun (dL -> L _ HsRecField {hsRecPun=True}) = True+#elif defined (GHC_8_10) || defined (GHC_9_0) || defined (GHC_9_2) isPFieldPun (L _ HsRecField {hsRecPun=True}) = True #else-isPFieldPun (dL -> L _ HsRecField {hsRecPun=True}) = True+isPFieldPun (L _ HsFieldBind {hfbPun=True}) = True #endif isPFieldPun _ = False  isPatTypeSig, isPBangPat, isPViewPat :: LPat GhcPs -> Bool-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-isPatTypeSig (L _ SigPat{}) = True; isPatTypeSig _ = False-isPBangPat (L _ BangPat{}) = True; isPBangPat _ = False-isPViewPat (L _ ViewPat{}) = True; isPViewPat _ = False-#else+#if defined (GHC_8_8) isPatTypeSig (dL -> L _ SigPat{}) = True; isPatTypeSig _ = False isPBangPat (dL -> L _ BangPat{}) = True; isPBangPat _ = False isPViewPat (dL -> L _ ViewPat{}) = True; isPViewPat _ = False+#else+isPatTypeSig (L _ SigPat{}) = True; isPatTypeSig _ = False+isPBangPat (L _ BangPat{}) = True; isPBangPat _ = False+isPViewPat (L _ ViewPat{}) = True; isPViewPat _ = False #endif  isSplicePat :: LPat GhcPs -> Bool-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-isSplicePat (L _ SplicePat{}) = True; isSplicePat _ = False-#else+#if defined (GHC_8_8) isSplicePat (dL -> L _ SplicePat{}) = True; isSplicePat _ = False+#else+isSplicePat (L _ SplicePat{}) = True; isSplicePat _ = False #endif
src/Language/Haskell/GhclibParserEx/GHC/Hs/Type.hs view
@@ -1,34 +1,35 @@ -- Copyright (c) 2021-2023, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause.--{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} #include "ghclib_api.h"-module Language.Haskell.GhclibParserEx.GHC.Hs.Type (-    fromTyParen-  , isTyQuasiQuote, isUnboxedTuple, isKindTyApp-) where+module Language.Haskell.GhclibParserEx.GHC.Hs.Type+  ( fromTyParen,+    isTyQuasiQuote,+    isUnboxedTuple,+    isKindTyApp,+  )+where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-import GHC.Hs-#else+#if defined (GHC_8_8) import HsSyn-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0)-import GHC.Types.SrcLoc #else+import GHC.Hs+#endif+#if defined (GHC_8_8) || defined (GHC_8_10) import SrcLoc+#else+import GHC.Types.SrcLoc #endif  isKindTyApp :: LHsType GhcPs -> Bool-isKindTyApp = \case (L _ HsAppKindTy{}) -> True; _ -> False+isKindTyApp = \case (L _ HsAppKindTy {}) -> True; _ -> False  fromTyParen :: LHsType GhcPs -> LHsType GhcPs fromTyParen (L _ (HsParTy _ x)) = x fromTyParen x = x  isTyQuasiQuote :: LHsType GhcPs -> Bool-isTyQuasiQuote (L _ (HsSpliceTy _ HsQuasiQuote{})) = True+isTyQuasiQuote (L _ (HsSpliceTy _ HsQuasiQuote {})) = True isTyQuasiQuote _ = False  isUnboxedTuple :: HsTupleSort -> Bool
src/Language/Haskell/GhclibParserEx/GHC/Hs/Types.hs view
@@ -2,8 +2,9 @@ -- SPDX-License-Identifier: BSD-3-Clause.  module Language.Haskell.GhclibParserEx.GHC.Hs.Types-  {-# DEPRECATED "Use Language.Haskell.GhclibParserEx.GHC.Hs.Type instead" #-} (-  module Language.Haskell.GhclibParserEx.GHC.Hs.Type-  ) where+  {-# DEPRECATED "Use Language.Haskell.GhclibParserEx.GHC.Hs.Type instead" #-}+  ( module Language.Haskell.GhclibParserEx.GHC.Hs.Type,+  )+where  import Language.Haskell.GhclibParserEx.GHC.Hs.Type
src/Language/Haskell/GhclibParserEx/GHC/Parser.hs view
@@ -1,7 +1,7 @@--- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved.+-- Copyright (c) 2020-2024, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. -{-# LANGUAGE CPP #-}+{- ORMOLU_DISABLE -} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Parser(     parseFile@@ -22,20 +22,45 @@   )   where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)-import GHC.Hs-#else+#if defined (GHC_8_8) import HsSyn-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)-#  if defined (GHC_9_2)+import DynFlags+import StringBuffer+import Lexer+import qualified Parser+import FastString+import SrcLoc+import BkpSyn+import PackageConfig+import RdrName+#elif defined (GHC_8_10)+import GHC.Hs+import DynFlags+import StringBuffer+import Lexer+import qualified Parser+import FastString+import SrcLoc+import BkpSyn+import PackageConfig+import RdrName+import RdrHsSyn+#elif defined (GHC_9_0)+import GHC.Hs+import GHC.Parser.PostProcess+import GHC.Driver.Session+import GHC.Data.StringBuffer+import GHC.Parser.Lexer+import qualified GHC.Parser.Lexer as Lexer+import qualified GHC.Parser as Parser+import GHC.Data.FastString+import GHC.Types.SrcLoc+import GHC.Driver.Backpack.Syntax+import GHC.Unit.Info+import GHC.Types.Name.Reader+#elif defined (GHC_9_2)+import GHC.Hs import GHC.Driver.Config-#  endif-#  if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)-import GHC.Driver.Config.Parser-#  endif-#endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0) import GHC.Parser.PostProcess import GHC.Driver.Session import GHC.Data.StringBuffer@@ -48,18 +73,19 @@ import GHC.Unit.Info import GHC.Types.Name.Reader #else-import DynFlags-import StringBuffer-import Lexer-import qualified Parser-import FastString-import SrcLoc-import BkpSyn-import PackageConfig-import RdrName-#endif-#if defined (GHC_8_10)-import RdrHsSyn+import GHC.Hs+import GHC.Driver.Config.Parser+import GHC.Parser.PostProcess+import GHC.Driver.Session+import GHC.Data.StringBuffer+import GHC.Parser.Lexer+import qualified GHC.Parser.Lexer as Lexer+import qualified GHC.Parser as Parser+import GHC.Data.FastString+import GHC.Types.SrcLoc+import GHC.Driver.Backpack.Syntax+import GHC.Unit.Info+import GHC.Types.Name.Reader #endif  parse :: P a -> String -> DynFlags -> ParseResult a@@ -69,7 +95,7 @@     location = mkRealSrcLoc (mkFastString "<string>") 1 1     buffer = stringToStringBuffer str     parseState =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )       initParserState (initParserOpts flags) buffer location #else       mkPState flags buffer location@@ -101,10 +127,8 @@ parseDeclaration = parse Parser.parseDeclaration  parseExpression :: String -> DynFlags -> ParseResult (LHsExpr GhcPs)-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) parseExpression s flags =-  -- The need for annotations here came about first manifested with-  -- ghc-9.0.1   case parse Parser.parseExpression s flags of     POk state e ->       let e' = e :: ECP@@ -130,7 +154,7 @@ parseStmt :: String -> DynFlags -> ParseResult (Maybe (LStmt GhcPs (LHsExpr GhcPs))) parseStmt = parse Parser.parseStmt -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) parseIdentifier :: String -> DynFlags -> ParseResult (LocatedN RdrName) #else parseIdentifier :: String -> DynFlags -> ParseResult (Located RdrName)@@ -164,7 +188,7 @@     location = mkRealSrcLoc (mkFastString filename) 1 1     buffer = stringToStringBuffer str     parseState =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2)+#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )       initParserState (initParserOpts flags) buffer location #else       mkPState flags buffer location
src/Language/Haskell/GhclibParserEx/GHC/Settings/Config.hs view
@@ -1,24 +1,22 @@--- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved.+-- Copyright (c) 2020-2024, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. +{- ORMOLU_DISABLE -} {-# OPTIONS_GHC -Wno-missing-fields #-}-{-# LANGUAGE CPP #-} #include "ghclib_api.h"- module Language.Haskell.GhclibParserEx.GHC.Settings.Config(     fakeSettings-#if !defined (GHC_9_10) && !defined (GHC_9_8) && !defined (GHC_9_6)+#if defined (GHC_8_8) || defined (GHC_8_10) || defined (GHC_9_0) || defined (GHC_9_2) || defined (GHC_9_4)   , fakeLlvmConfig #endif   ) where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0)-import GHC.Settings.Config-import GHC.Driver.Session-import GHC.Utils.Fingerprint-import GHC.Platform-import GHC.Settings+#if defined (GHC_8_8)+import Config+import DynFlags+import Fingerprint+import Platform #elif defined (GHC_8_10) import Config import DynFlags@@ -26,53 +24,93 @@ import GHC.Platform import ToolSettings #else-import Config-import DynFlags-import Fingerprint-import Platform+import GHC.Settings.Config+import GHC.Driver.Session+import GHC.Utils.Fingerprint+import GHC.Platform+import GHC.Settings #endif+#if ! (defined (GHC_9_12) || defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+{- since 9.14 -}+import GHC.Unit.Types (stringToUnitId)+#endif  fakeSettings :: Settings fakeSettings = Settings-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)|| defined (GHC_8_10)+#if defined (GHC_8_8)+  { sTargetPlatform=platform+  , sPlatformConstants=platformConstants+  , sProjectVersion=cProjectVersion+  , sProgramName="ghc"+  , sOpt_P_fingerprint=fingerprint0+  }+#elif defined (GHC_8_10) || defined (GHC_9_0)   { sGhcNameVersion=ghcNameVersion   , sFileSettings=fileSettings   , sTargetPlatform=platform   , sPlatformMisc=platformMisc-#  if !defined(GHC_9_10) && !defined (GHC_9_8) && !defined(GHC_9_6) && !defined(GHC_9_4) && !defined(GHC_9_2)   , sPlatformConstants=platformConstants-#  endif   , sToolSettings=toolSettings   }+#elif (defined (GHC_9_2) || defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12))+  { sGhcNameVersion=ghcNameVersion+  , sFileSettings=fileSettings+  , sTargetPlatform=platform+  , sPlatformMisc=platformMisc+  , sToolSettings=toolSettings+  } #else-  { sTargetPlatform=platform-  , sPlatformConstants=platformConstants-  , sProjectVersion=cProjectVersion-  , sProgramName="ghc"-  , sOpt_P_fingerprint=fingerprint0+ {- defined (GHC_9_14) -}+  { sGhcNameVersion=ghcNameVersion+  , sFileSettings=fileSettings+  , sTargetPlatform=platform+  , sPlatformMisc=platformMisc+  , sToolSettings=toolSettings+  , sUnitSettings=unitSettings   } #endif   where-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)|| defined (GHC_8_10)+#if !(defined (GHC_8_8) || defined (GHC_8_10) || defined (GHC_9_0) || defined (GHC_9_2) || (defined GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12))+{- ghc-api>=9.14.1  -}+    unitSettings = UnitSettings {+        unitSettings_baseUnitId = stringToUnitId "base"+      }+#endif++#if !defined (GHC_8_8)     toolSettings = ToolSettings {-      toolSettings_opt_P_fingerprint=fingerprint0+        toolSettings_opt_P_fingerprint=fingerprint0       }     fileSettings = FileSettings {}     platformMisc = PlatformMisc {}-    ghcNameVersion =-      GhcNameVersion{ghcNameVersion_programName="ghc"-                    ,ghcNameVersion_projectVersion=cProjectVersion-                    }+    ghcNameVersion = GhcNameVersion {+        ghcNameVersion_programName="ghc"+      , ghcNameVersion_projectVersion=cProjectVersion+      } #endif-    platform =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)-      genericPlatform-#else-      Platform{-#  if defined (GHC_9_0)-    -- It doesn't matter what values we write here as these fields are-    -- not referenced for our purposes. However the fields are strict-    -- so we must say something.+#if defined (GHC_8_8) || defined (GHC_8_10) || defined (GHC_9_0)+    platformConstants = PlatformConstants {+        pc_DYNAMIC_BY_DEFAULT=False+      , pc_WORD_SIZE=8+      }+#endif+#if defined (GHC_8_8)+    platform = Platform {+        platformWordSize=8+      , platformOS=OSUnknown+      , platformUnregisterised=True+      }+#elif defined (GHC_8_10)+    platform = Platform {+        platformWordSize=PW8+      , platformMini=PlatformMini {+            platformMini_arch=ArchUnknown+          , platformMini_os=OSUnknown+          }+      , platformUnregisterised=True+      }+#elif defined (GHC_9_0)+    platform = Platform {         platformByteOrder=LittleEndian       , platformHasGnuNonexecStack=True       , platformHasIdentDirective=False@@ -80,29 +118,18 @@       , platformIsCrossCompiling=False       , platformLeadingUnderscore=False       , platformTablesNextToCode=False-      ,-#  endif-#  if defined (GHC_8_10) || defined (GHC_9_0)-        platformWordSize=PW8+      , platformWordSize=PW8       , platformMini=PlatformMini {platformMini_arch=ArchUnknown, platformMini_os=OSUnknown}-#  else-        platformWordSize=8-      , platformOS=OSUnknown-#  endif       , platformUnregisterised=True       }-#endif-#if !defined(GHC_9_10) && !defined (GHC_9_8) && !defined(GHC_9_6) && !defined(GHC_9_4) && !defined(GHC_9_2)-    platformConstants =-      PlatformConstants{pc_DYNAMIC_BY_DEFAULT=False,pc_WORD_SIZE=8}+#else+    platform = genericPlatform #endif -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6)--- Intentionally empty-#elif defined(GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)|| defined (GHC_8_10)-fakeLlvmConfig :: LlvmConfig-fakeLlvmConfig = LlvmConfig [] []-#else+#if defined (GHC_8_8) fakeLlvmConfig :: (LlvmTargets, LlvmPasses) fakeLlvmConfig = ([], [])+#elif defined (GHC_8_10) || defined (GHC_9_0) || defined(GHC_9_2) || defined(GHC_9_4)+fakeLlvmConfig :: LlvmConfig+fakeLlvmConfig = LlvmConfig [] [] #endif
src/Language/Haskell/GhclibParserEx/GHC/Types/Name/Reader.hs view
@@ -1,33 +1,36 @@ -- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. -{-# LANGUAGE CPP #-} #include "ghclib_api.h"--module Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader(-   occNameStr, rdrNameStr, isSpecial, unqual, fromQual, isSymbolRdrName- )+module Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader+  ( occNameStr,+    rdrNameStr,+    isSpecial,+    unqual,+    fromQual,+    isSymbolRdrName,+  ) where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined(GHC_9_4) || defined (GHC_9_2)+#if !( defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) import GHC.Parser.Annotation #endif -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined(GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)-import GHC.Types.SrcLoc-import GHC.Types.Name-import GHC.Types.Name.Reader-#else+#if defined (GHC_8_8) || defined (GHC_8_10) import SrcLoc import RdrName import OccName import Name+#else+import GHC.Types.SrcLoc+import GHC.Types.Name+import GHC.Types.Name.Reader #endif  -- These names may not seem natural here but they work out in -- practice. The use of thse two functions is thoroughly ubiquitous. occNameStr :: RdrName -> String; occNameStr = occNameString . rdrNameOcc-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined(GHC_9_4) || defined (GHC_9_2)+#if ! ( defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) rdrNameStr :: GHC.Parser.Annotation.LocatedN RdrName -> String #else rdrNameStr :: Located RdrName -> String@@ -35,7 +38,7 @@ rdrNameStr = occNameStr . unLoc  -- Builtin type or data constructors.-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined(GHC_9_4) || defined (GHC_9_2)+#if ! ( defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) isSpecial :: LocatedN RdrName -> Bool #else isSpecial :: Located RdrName -> Bool@@ -45,7 +48,7 @@  -- Coerce qualified names to unqualified (by discarding the -- qualifier).-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined(GHC_9_4) || defined (GHC_9_2)+#if ! ( defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) unqual :: LocatedN RdrName -> LocatedN RdrName #else unqual :: Located RdrName -> Located RdrName@@ -54,7 +57,7 @@ unqual x = x  -- Extract the occ name from a qualified/unqualified reader name.-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined(GHC_9_4) || defined (GHC_9_2)+#if ! ( defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) ) fromQual :: LocatedN RdrName -> Maybe OccName #else fromQual :: Located RdrName -> Maybe OccName
src/Language/Haskell/GhclibParserEx/GHC/Utils/Outputable.hs view
@@ -1,22 +1,22 @@ -- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. -{-# LANGUAGE CPP #-}+{- ORMOLU_DISABLE -} #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.GHC.Utils.Outputable (     unsafePrettyPrint ) where -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)-import GHC.Utils.Outputable-#else+#if defined (GHC_8_8) || defined (GHC_8_10) import Outputable+#else+import GHC.Utils.Outputable #endif  unsafePrettyPrint :: Outputable a => a -> String unsafePrettyPrint =-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if ! ( defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )   showPprUnsafe . ppr #else   showSDocUnsafe . ppr
test/Test.hs view
@@ -14,18 +14,19 @@ import qualified System.FilePath as FilePath import System.IO.Extra import Control.Monad+import Data.Data import Data.List.Extra import Data.Maybe import Data.Generics.Uniplate.Data-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)+#if !(defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8)) import GHC.Data.Bag-#if !defined (GHC_9_2)+#  if !defined (GHC_9_2) import GHC.Driver.Errors.Types-#endif+#  endif import GHC.Types.Error #endif -import Language.Haskell.GhclibParserEx.Dump+import Language.Haskell.GhclibParserEx.GHC.Hs.Dump import Language.Haskell.GhclibParserEx.Fixity import Language.Haskell.GhclibParserEx.GHC.Settings.Config import Language.Haskell.GhclibParserEx.GHC.Parser@@ -47,21 +48,26 @@ import Language.Haskell.GhclibParserEx.GHC.Driver.Session import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader -#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10)+#if !defined (GHC_8_8)+-- ghc >= 8.10 import GHC.Hs #else import HsSyn #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0)+#if !( defined (GHC_8_10) || defined (GHC_8_8) )+-- ghc >= 9.0 import GHC.Types.SrcLoc import GHC.Driver.Session import GHC.Parser.Lexer-#  if !defined (GHC_9_10) && !defined (GHC_9_8) && !defined (GHC_9_6)+#  if defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0)+--   9.0 <= ghc <= 9.4 import GHC.Utils.Outputable #  endif #  if !defined (GHC_9_0)+--   ghc >= 9.2 import GHC.Driver.Ppr-#    if !defined (GHC_9_10) && !defined (GHC_9_8) && !defined (GHC_9_6) && !defined (GHC_9_4)+#    if defined (GHC_9_2)+--     ghc = 9.2 import GHC.Parser.Errors.Ppr #    endif #  endif@@ -69,6 +75,7 @@ import GHC.Types.Name.Reader import GHC.Types.Name.Occurrence #else+-- ghc < 9.0 import SrcLoc import DynFlags import Lexer@@ -77,15 +84,17 @@ import RdrName import OccName #endif-import GHC.LanguageExtensions.Type #if defined (GHC_8_8)+-- ghc = 8.8 import Bag #endif+import GHC.LanguageExtensions.Type  basicDynFlags :: DynFlags basicDynFlags =   defaultDynFlags fakeSettings-#if !defined (GHC_9_10) && !defined (GHC_9_8) && !defined (GHC_9_6)+#if defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8)+-- ghc <= 9.4                                 fakeLlvmConfig #endif @@ -101,6 +110,7 @@   , fixityTests   , extendInstancesTests   , expressionPredicateTests+  , declarationPredicateTests   , typePredicateTests   , patternPredicateTests   , dynFlagsTests@@ -113,7 +123,8 @@     writeFile relPath contents     return relPath -#if defined(GHC_9_10) || defined (GHC_9_8) || defined(GHC_9_6)+#if !(defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.6 report :: DynFlags -> Bag (MsgEnvelope GhcMessage) -> String report flags msgs = concat [ showSDoc flags msg | msg <- pprMsgEnvelopeBagWithLocDefault msgs ] #elif defined (GHC_9_4)@@ -130,7 +141,8 @@ chkParseResult :: DynFlags -> ParseResult a -> IO () chkParseResult flags = \case     POk s _ -> do-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if !(defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.4       let (wrns, errs) = getPsMessages s #elif defined (GHC_9_2)       let (wrns, errs) = getMessages s@@ -138,7 +150,8 @@       let (wrns, errs) = getMessages s flags #endif       when (not (null errs) || not (null wrns)) $-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if !(defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.4         assertFailure (           report flags (getMessages (GhcPsMessage <$> wrns)) ++           report flags (getMessages (GhcPsMessage <$> errs))@@ -148,7 +161,8 @@ #else         assertFailure (report flags wrns ++ report flags errs) #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if !(defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.4     PFailed s -> assertFailure (report flags $ getMessages (GhcPsMessage <$> snd (getPsMessages s))) #elif defined (GHC_9_2)     PFailed s -> assertFailure (report flags $ fmap pprError (snd (getMessages s)))@@ -158,6 +172,9 @@     PFailed _ loc err -> assertFailure (report flags $ unitBag $ mkPlainErrMsg flags loc err) #endif +hasS :: (Data x, Data a) => (a -> Bool) -> x -> Bool+hasS test = any test . universeBi+ parseTests :: TestTree parseTests = testGroup "Parse tests"   [@@ -239,6 +256,12 @@         POk _ e -> test e         _ -> assertFailure "parse error" +declTest :: String -> DynFlags -> (LHsDecl GhcPs -> IO ()) -> IO ()+declTest s flags test =+      case parseDeclaration s flags of+        POk _ e -> test e+        _ -> assertFailure "parse error"+ stmtTest :: String -> DynFlags -> (LStmt GhcPs (LHsExpr GhcPs) -> IO ()) -> IO () stmtTest s flags test =       case parseStatement s flags of@@ -263,7 +286,8 @@       exprTest "1 + 2 * 3" flags         (\e ->             assertBool "parse tree not affected" $-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)+#if !(defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.2               showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations e) /=               showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations (applyFixities [] e)) #else@@ -275,7 +299,8 @@       case parseDeclaration "f (1 : 2 :[]) = 1" flags of         POk _ d ->           assertBool "parse tree not affected" $-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2)+#if !(defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.2           showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations d) /=           showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations (applyFixities [] d)) #else@@ -321,6 +346,17 @@     test_with_exts exts s = typeTest s (flags exts)     flags = foldl' xopt_set basicDynFlags +declarationPredicateTests :: TestTree+declarationPredicateTests = testGroup "Declaration predicate tests"+  [+    testCase "isStrictMatch" $ test "x = e" $ assert' . not . hasS isStrictMatch+  , testCase "isStrictMatch" $ test "!x = e" $ assert' . hasS isStrictMatch+  ]+  where+    assert' = assertBool ""+    test s = declTest s (flags [ BangPatterns ])+    flags = foldl' xopt_set basicDynFlags+ expressionPredicateTests :: TestTree expressionPredicateTests = testGroup "Expression predicate tests"   [ testCase "isTag" $ test "foo" $ assert' . isTag "foo"@@ -329,12 +365,20 @@   , testCase "isDot" $ test "f . g" $ \case L _ (OpApp _ _ op _) -> assert' $ isDot op; _ -> assertFailure "unexpected"   , testCase "isReturn" $ test "return x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected"   , testCase "isReturn" $ test "pure x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected"-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if !(defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.8+  , testCase "isSection" $ test "(1 +)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected"+#elif !(defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.4   , testCase "isSection" $ test "(1 +)" $ \case L _ (HsPar _ _ x _) -> assert' $ isSection x; _ -> assertFailure "unexpected" #else   , testCase "isSection" $ test "(1 +)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected" #endif-#if defined (GHC_9_10) || defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4)+#if !(defined (GHC_9_8) || defined (GHC_9_6) || defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.8+  , testCase "isSection" $ test "(+ 1)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected"+#elif !(defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))+-- ghc >= 9.4   , testCase "isSection" $ test "(+ 1)" $ \case L _ (HsPar _ _ x _) -> assert' $ isSection x; _ -> assertFailure "unexpected" #else   , testCase "isSection" $ test "(+ 1)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected"@@ -359,6 +403,7 @@   , testCase "isLexeme" $ test "3" $ assert' . isLexeme   , testCase "isLexeme" $ test "f x" $ assert' . not . isLexeme   , testCase "isLambda" $ test "\\x -> 12" $ assert' . isLambda+  , testCase "isLambda" $ test_with_exts [ LambdaCase ]  "\\case _ -> 12" $ assert' . not . isLambda   , testCase "isLambda" $ test "foo" $ assert' . not . isLambda   , testCase "isDotApp" $ test "f . g" $ assert' . isDotApp   , testCase "isDotApp" $ test "f $ g" $ assert' . not . isDotApp@@ -389,7 +434,7 @@   , testCase "isSpliceDecl" $ test "$x" $ assert' . isSpliceDecl . unLoc   , testCase "isSpliceDecl" $ test "f$x" $ assert' . not . isSpliceDecl . unLoc   , testCase "isSpliceDecl" $ test "$(a + b)" $ assert' . isSpliceDecl . unLoc-#if !( defined(GHC_8_8) || defined(GHC_8_10) || defined (GHC_9_0) || defined (GHC_9_2) || defined(GHC_9_4) )+#if !(defined (GHC_9_4) || defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8))   -- ghc api >= 9.6.1   , testCase "isTypedSplice" $ test "$$foo" $ assert' . isTypedSplice . unLoc   , testCase "isTypedSplice" $ test "$foo" $ assert' . not . isTypedSplice . unLoc@@ -443,6 +488,8 @@   , testCase "fromPChar" $ test "'a'" $ assert' . (== Just 'a') . fromPChar   , testCase "fromPChar" $ test "\"a\"" $ assert' . isNothing . fromPChar   , testCase "isSplicePat" $ test "$(varP pylonExPtrVarName)" $ assert' . isSplicePat+  , testCase "isWildPat" $ test "_" $ assert' . isWildPat+  , testCase "isWildPat" $ test "p@(L _ (VisPat _ pat))" $ assert' . not . isWildPat   ]   where     assert' = assertBool ""