ghc-lib-parser-ex 9.6.0.2 → 9.14.2.0
raw patch · 24 files changed
Files
- CI.hs +150/−0
- ChangeLog.md +23/−3
- README.md +10/−8
- cbits/ghclib_api.h +18/−3
- ghc-lib-parser-ex.cabal +71/−84
- src/Language/Haskell/GhclibParserEx/Dump.hs +7/−239
- src/Language/Haskell/GhclibParserEx/Fixity.hs +76/−41
- src/Language/Haskell/GhclibParserEx/GHC/Driver/Flags.hs +1/−5
- src/Language/Haskell/GhclibParserEx/GHC/Driver/Session.hs +62/−22
- src/Language/Haskell/GhclibParserEx/GHC/Hs.hs +16/−16
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Binds.hs +9/−9
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Decls.hs +15/−12
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Dump.hs +241/−0
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Expr.hs +116/−50
- src/Language/Haskell/GhclibParserEx/GHC/Hs/ExtendInstances.hs +5/−5
- src/Language/Haskell/GhclibParserEx/GHC/Hs/ImpExp.hs +11/−13
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Pat.hs +106/−103
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Type.hs +15/−14
- src/Language/Haskell/GhclibParserEx/GHC/Hs/Types.hs +4/−3
- src/Language/Haskell/GhclibParserEx/GHC/Parser.hs +56/−32
- src/Language/Haskell/GhclibParserEx/GHC/Settings/Config.hs +82/−55
- src/Language/Haskell/GhclibParserEx/GHC/Types/Name/Reader.hs +18/−15
- src/Language/Haskell/GhclibParserEx/GHC/Utils/Outputable.hs +5/−5
- test/Test.hs +66/−19
+ 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 [](http://opensource.org/licenses/BSD-3-Clause) [](https://hackage.haskell.org/package/ghc-lib-parser-ex) [](https://www.stackage.org/package/ghc-lib-parser-ex) [](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+ [](http://opensource.org/licenses/BSD-3-Clause) [](https://hackage.haskell.org/package/ghc-lib-parser-ex) [](https://www.stackage.org/package/ghc-lib-parser-ex) [](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 ""