Support ghc-8.10. (#69)

The biggest API change is that ghc-8.10 organizes its modules into
a hierarchy, such as `GHC.Hs.Expr` instead of `HsExpr`. To work
around that without adding even more CPP, I added some `other-modules`
providing the new names for older GHC releases.

Fixes #65 .
This commit is contained in:
Judah Jacobson 2020-05-22 11:07:15 -07:00 committed by GitHub
parent 2222198e23
commit 3aa49fff6f
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
28 changed files with 207 additions and 55 deletions

View File

@ -51,6 +51,23 @@ jobs:
- ~/.stack
- .stack-work
build-ghc-8.10:
docker:
- image: circleci/rust:1.36-stretch
steps:
- checkout
- restore_cache:
keys:
- stack-cache-v2-ghc-8.10-{{ arch }}-{{ .Branch }}
- stack-cache-v2-ghc-8.10-{{ arch }}-master
- run: .circleci/install-stack.sh
- run: stack test --no-terminal --resolver=lts-15.13
- save_cache:
key: stack-cache-v2-ghc-8.10-{{ arch }}-{{ .Branch }}-{{ epoch }}
paths:
- ~/.stack
- .stack-work
build-success:
docker:
- image: circleci/rust:1.36-stretch
@ -64,8 +81,10 @@ workflows:
- build-12.8
- build-13.23
- build-15.13
- build-ghc-8.10
- build-success:
requires:
- build-12.8
- build-13.23
- build-15.13
- build-ghc-8.10

View File

@ -10,6 +10,7 @@
- Remove support for ghc-8.2.*.
## Other Changes
- Add support for ghc-8.10.
- Add `kindedVar`.
- Add `tuplePromotedTy`.

2
compat/GHC/Hs.hs Normal file
View File

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

2
compat/GHC/Hs/Binds.hs Normal file
View File

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

2
compat/GHC/Hs/Decls.hs Normal file
View File

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

2
compat/GHC/Hs/Expr.hs Normal file
View File

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

View File

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

2
compat/GHC/Hs/ImpExp.hs Normal file
View File

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

2
compat/GHC/Hs/Lit.hs Normal file
View File

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

2
compat/GHC/Hs/Pat.hs Normal file
View File

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

2
compat/GHC/Hs/Types.hs Normal file
View File

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

View File

@ -39,12 +39,18 @@ import qualified FastString as GHC
import qualified GHC as GHC
import qualified GhcMonad as GHC
import qualified HeaderInfo as GHC
import qualified Outputable as GHC
import qualified Lexer as GHC
import qualified Parser as Parser
import qualified SrcLoc as GHC
import qualified StringBuffer as GHC
import GHC.Paths (libdir)
#if MIN_VERSION_ghc(8,10,0)
import System.Exit (exitFailure)
import GhcMonad (liftIO)
import qualified ErrUtils
#else
import qualified Outputable as GHC
#endif
main :: IO ()
main = do
@ -61,10 +67,19 @@ parseModule f = GHC.runGhc (Just libdir) $ do
let state = GHC.mkPState dflags' contents (GHC.mkRealSrcLoc (GHC.fsLit f) 1 1)
case GHC.unP Parser.parseModule state of
GHC.POk _state m -> return $ GHC.unLoc m
#if MIN_VERSION_ghc(8,10,0)
GHC.PFailed s -> liftIO $ do
let (_warnings, errors) = GHC.messages s dflags
ErrUtils.printBagOfErrors dflags errors
exitFailure
#else
GHC.PFailed
_message
-- Note: using printBagOfErrors on the messages doesn't produce any
-- useful output on older GHCs; so instead print the docs directly.
_messages
loc docs ->
error $ GHC.showPpr dflags loc ++ GHC.showSDoc dflags docs
error $ GHC.showPpr dflags loc ++ ": " ++ GHC.showSDoc dflags docs
#endif
gPrint :: Data a => a -> Doc
gPrint x

View File

@ -30,7 +30,7 @@ description: |
dependencies:
- base >= 4.7 && < 5
- ghc >= 8.4 && < 8.9
- ghc >= 8.4 && < 8.11
default-extensions:
- DataKinds
@ -38,6 +38,22 @@ default-extensions:
- TypeSynonymInstances
library:
when:
# GHC-8.10 introduced hierarchical modules.
# For compatibility, define wrapper modules for older GHC versions.
- condition: impl(ghc<8.10)
source-dirs: compat
other-modules:
- GHC.Hs
- GHC.Hs.Binds
- GHC.Hs.Decls
- GHC.Hs.Expr
- GHC.Hs.Extension
- GHC.Hs.ImpExp
- GHC.Hs.Lit
- GHC.Hs.Pat
- GHC.Hs.Types
source-dirs: src
other-modules:
- GHC.SourceGen.Binds.Internal

View File

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

View File

@ -9,9 +9,9 @@ module GHC.SourceGen.Binds.Internal where
import BasicTypes (Origin(Generated))
import Bag (listToBag)
import HsBinds
import HsDecls
import HsExpr (MatchGroup(..), Match(..), GRHSs(..))
import GHC.Hs.Binds
import GHC.Hs.Decls
import GHC.Hs.Expr (MatchGroup(..), Match(..), GRHSs(..))
import SrcLoc (Located)
#if !MIN_VERSION_ghc(8,6,0)

View File

@ -50,9 +50,9 @@ import BasicTypes (LexicalFixity(Prefix))
import BasicTypes (DerivStrategy(..))
#endif
import Bag (listToBag)
import HsBinds
import HsDecls
import HsTypes
import GHC.Hs.Binds
import GHC.Hs.Decls
import GHC.Hs.Types
( ConDeclField(..)
, FieldOcc(..)
, HsConDetails(..)
@ -66,8 +66,10 @@ import HsTypes
)
import SrcLoc (Located)
#if MIN_VERSION_ghc(8,6,0)
import HsExtension (NoExt(NoExt))
#if MIN_VERSION_ghc(8,10,0)
import GHC.Hs.Extension (NoExtField(NoExtField))
#elif MIN_VERSION_ghc(8,6,0)
import GHC.Hs.Extension (NoExt(NoExt))
#else
import PlaceHolder (PlaceHolder(..))
#endif
@ -144,7 +146,9 @@ class'
class' context name vars decls
= noExt TyClD $ ClassDecl
{ tcdCtxt = builtLoc $ map builtLoc context
#if MIN_VERSION_ghc(8,6,0)
#if MIN_VERSION_ghc(8,10,0)
, tcdCExt = NoExtField
#elif MIN_VERSION_ghc(8,6,0)
, tcdCExt = NoExt
#else
, tcdFVs = PlaceHolder
@ -193,7 +197,9 @@ instance HasValBind RawInstDecl where
instance' :: HsType' -> [RawInstDecl] -> HsDecl'
instance' ty decls = noExt InstD $ noExt ClsInstD $ ClsInstDecl
{ cid_poly_ty = sigType ty
#if MIN_VERSION_ghc(8,6,0)
#if MIN_VERSION_ghc(8,10,0)
, cid_ext = NoExtField
#elif MIN_VERSION_ghc(8,6,0)
, cid_ext = NoExt
#endif
, cid_binds = listToBag [builtLoc b | InstBind b <- decls]

View File

@ -23,9 +23,9 @@ module GHC.SourceGen.Expr
, recordUpd
) where
import HsExpr
import HsPat (HsRecField'(..), HsRecFields(..))
import HsTypes (FieldOcc(..), AmbiguousFieldOcc(..))
import GHC.Hs.Expr
import GHC.Hs.Pat (HsRecField'(..), HsRecFields(..))
import GHC.Hs.Types (FieldOcc(..), AmbiguousFieldOcc(..))
import Data.String (fromString)
import SrcLoc (unLoc, GenLocated(..), Located)

View File

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

View File

@ -18,9 +18,9 @@ module GHC.SourceGen.Lit
import BasicTypes (FractionalLit(..))
import BasicTypes(IntegralLit(..), SourceText(..))
import HsLit
import HsExpr (noExpr, noSyntaxExpr, HsExpr(..))
import HsPat (Pat(..))
import GHC.Hs.Lit
import GHC.Hs.Expr (noExpr, noSyntaxExpr, HsExpr(..))
import GHC.Hs.Pat (Pat(..))
import FastString (fsLit)
import GHC.SourceGen.Lit.Internal

View File

@ -8,7 +8,7 @@ module GHC.SourceGen.Lit.Internal where
import BasicTypes (SourceText(NoSourceText), FractionalLit(..))
import BasicTypes (IntegralLit(..))
import HsLit
import GHC.Hs.Lit
import GHC.SourceGen.Syntax.Internal
noSourceText :: (SourceText -> a) -> a

View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
@ -25,10 +26,13 @@ module GHC.SourceGen.Module
, moduleContents
) where
import HsImpExp (LIEWrappedName, IEWildcard(..), IEWrappedName(..), IE(..))
import HsSyn
import GHC.Hs.ImpExp (LIEWrappedName, IEWildcard(..), IEWrappedName(..), IE(..))
import GHC.Hs
( HsModule(..)
, ImportDecl(..)
#if MIN_VERSION_ghc(8,10,0)
, ImportDeclQualifiedStyle(..)
#endif
)
import RdrName (RdrName)
@ -53,7 +57,13 @@ module' name exports imports decls = HsModule
}
qualified' :: ImportDecl' -> ImportDecl'
qualified' d = d { ideclQualified = True }
qualified' d = d { ideclQualified =
#if MIN_VERSION_ghc(8,10,0)
QualifiedPre
#else
True
#endif
}
as' :: ImportDecl' -> ModuleNameStr -> ImportDecl'
as' d m = d { ideclAs = Just (builtLoc $ unModuleNameStr m) }
@ -61,7 +71,13 @@ as' d m = d { ideclAs = Just (builtLoc $ unModuleNameStr m) }
import' :: ModuleNameStr -> ImportDecl'
import' m = noSourceText (noExt ImportDecl)
(builtLoc $ unModuleNameStr m)
Nothing False False False False Nothing Nothing
Nothing False False
#if MIN_VERSION_ghc(8,10,0)
NotQualified
#else
False
#endif
False Nothing Nothing
exposing :: ImportDecl' -> [IE'] -> ImportDecl'
exposing d ies = d

View File

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

View File

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

View File

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

View File

@ -9,7 +9,7 @@
module GHC.SourceGen.Syntax.Internal where
import HsSyn
import GHC.Hs
( HsDecl
, HsExpr(..)
, HsLit
@ -40,37 +40,48 @@ import HsSyn
, LHsRecUpdField
#endif
)
import HsBinds (Sig, HsLocalBinds)
import GHC.Hs.Binds (Sig, HsLocalBinds)
#if MIN_VERSION_ghc(8,6,0)
import HsDecls (DerivStrategy)
import GHC.Hs.Decls (DerivStrategy)
#else
import BasicTypes (DerivStrategy)
#endif
import HsDecls (HsDerivingClause)
import HsPat
import GHC.Hs.Decls (HsDerivingClause)
import GHC.Hs.Pat
import RdrName (RdrName)
import SrcLoc (SrcSpan, Located, GenLocated(..), mkGeneralSrcSpan)
#if MIN_VERSION_ghc(8,8,0)
import BasicTypes (PromotionFlag(..))
#else
import HsTypes (Promoted(..))
import GHC.Hs.Types (Promoted(..))
#endif
#if MIN_VERSION_ghc(8,6,0)
import HsExtension (NoExt(NoExt))
#if MIN_VERSION_ghc(8,10,0)
import GHC.Hs.Extension (NoExtField(NoExtField))
#elif MIN_VERSION_ghc(8,6,0)
import GHC.Hs.Extension (NoExt(NoExt))
#else
import PlaceHolder(PlaceHolder(..))
#endif
import HsExtension (GhcPs)
import GHC.Hs.Extension (GhcPs)
#if MIN_VERSION_ghc(8,6,0)
#if MIN_VERSION_ghc(8,10,0)
noExt :: (NoExtField -> a) -> a
noExt = ($ NoExtField)
noExtOrPlaceHolder :: (NoExtField -> a) -> a
noExtOrPlaceHolder = noExt
#else
noExt :: (NoExt -> a) -> a
noExt = ($ NoExt)
noExtOrPlaceHolder :: (NoExt -> a) -> a
noExtOrPlaceHolder = noExt
#endif
withPlaceHolder :: a -> a
withPlaceHolder = id
@ -100,10 +111,10 @@ builtSpan = mkGeneralSrcSpan "<ghc-source-gen>"
builtLoc :: e -> Located e
builtLoc = L builtSpan
-- In GHC-8.8, source locations for Pat aren't stored in each node, and
-- LPat is a synonym for Pat.
-- In GHC-8.8.* (but not >=8.10 or <=8.6), source locations for Pat aren't
-- stored in each node, and LPat is a synonym for Pat.
builtPat :: Pat' -> LPat'
#if MIN_VERSION_ghc(8,8,0)
#if MIN_VERSION_ghc(8,8,0) && !MIN_VERSION_ghc(8,10,0)
builtPat = id
#else
builtPat = builtLoc

View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
@ -21,7 +22,7 @@ module GHC.SourceGen.Type
) where
import Data.String (fromString)
import HsTypes
import GHC.Hs.Types
import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Lit.Internal (noSourceText)
@ -65,7 +66,11 @@ infixr 0 -->
-- > =====
-- > forall' [bvar "a"] $ var "T" @@ var "a"
forall' :: [HsTyVarBndr'] -> HsType' -> HsType'
forall' ts = noExt HsForAllTy (map builtLoc ts) . builtLoc
forall' ts = noExt HsForAllTy
#if MIN_VERSION_ghc(8,10,0)
ForallInvis -- "Invisible" forall, i.e., with a dot
#endif
(map builtLoc ts) . builtLoc
-- | Qualify a type with constraints.
--

View File

@ -7,7 +7,7 @@
{-# LANGUAGE CPP #-}
module GHC.SourceGen.Type.Internal where
import HsTypes
import GHC.Hs.Types as Types
import SrcLoc (Located, unLoc)
import GHC.SourceGen.Syntax.Internal
@ -21,7 +21,7 @@ sigType :: HsType' -> LHsSigType'
sigType = implicitBndrs . builtLoc
implicitBndrs :: t -> HsImplicitBndrs' t
implicitBndrs = withPlaceHolder . noExt (withPlaceHolder HsTypes.HsIB)
implicitBndrs = withPlaceHolder . noExt (withPlaceHolder Types.HsIB)
-- TODO: GHC >= 8.6 provides parenthesizeHsType. For consistency with
@ -58,7 +58,7 @@ parTy :: Located HsType' -> Located HsType'
parTy = builtLoc . noExt HsParTy
sigWcType :: HsType' -> LHsSigWcType'
sigWcType = noExt (withPlaceHolder HsTypes.HsWC) . sigType
sigWcType = noExt (withPlaceHolder Types.HsWC) . sigType
wcType :: HsType' -> LHsWcType'
wcType = noExt (withPlaceHolder HsTypes.HsWC) . builtLoc
wcType = noExt (withPlaceHolder Types.HsWC) . builtLoc

45
stack-8.10.yaml Normal file
View File

@ -0,0 +1,45 @@
# Copyright 2019 Google LLC
#
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file or at
# https://developers.google.com/open-source/licenses/bsd
resolver: ghc-8.10.1
packages:
- .
- ghc-show-ast
ghc-options:
"$locals": -Wall -Werror
setup-info:
ghc:
macosx:
8.10.1:
url: "https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-apple-darwin.tar.xz"
content-length: 192889416
sha1: 64828a2a2f444cbb5d77d4a15b51a29f03b657f2
sha256: 65b1ca361093de4804a7e40b3e68178e1ef720f84f743641ec8d95e56a45b3a8
extra-deps:
- ghc-paths-0.1.0.12@sha256:85370fdc615d4be5e09d9269eebb9a3fc7017c40b1a9e0050b121d75908564bd,632
- QuickCheck-2.13.2@sha256:ad4e5adbd1c9dc0221a44307b992cb040c515f31095182e47aa7e974bc461df1,6952
- tasty-1.2.3@sha256:bba67074e5326d57e8f53fc1dabcb6841daa4dc51b053506eb7f40a6f49a0497,2517
- tasty-hunit-0.10.0.2@sha256:8e8bd5807cec650f5aebc5ada07b57620c863e69145e65249651c1b48d97bd70,1515
- tasty-quickcheck-0.10.1.1@sha256:b0a751bbe706447fd11cac21a7bbcf919631813aafaba3ce460a421348f6935c,1543
- ansi-terminal-0.10.3@sha256:e2fbcef5f980dc234c7ad8e2fa433b0e8109132c9e643bc40ea5608cd5697797,3226
- async-2.2.2@sha256:a178c166856da7ff22fe4500337b54812e94fd2059409452187d72e057ede9cd,2934
- call-stack-0.2.0@sha256:5ce796b78d5f964468ec6fe0717b4e7d0430817f37370c47b3e6b38e345b6643,1202
- clock-0.8@sha256:b4ae207e2d3761450060a0d0feb873269233898039c76fceef9cc1a544067767,4113
- optparse-applicative-0.15.1.0@sha256:a0b9924d88a17c36cd8e6839d7dd2138419dd8f08cbb4f9af18f3c367b0c69a3,4673
- random-1.1@sha256:7b67624fd76ddf97c206de0801dc7e888097e9d572974be9b9ea6551d76965df,1777
- splitmix-0.0.4@sha256:fb9bb8b54a2e76c8a021fe5c4c3798047e1f60e168379a1f80693047fe00ad0e,4813
- tagged-0.8.6@sha256:1f7ca84e6c88cbb923641c60041c9f56c34f1a889759cc073cdf10542b441ff9,2606
- unbounded-delays-0.1.1.0@sha256:8e57c6ffb72ed605b85c69d3b3a7ebbbbb70bfb5e9b9816309f1f733240838f2,1184
- wcwidth-0.0.2@sha256:77531eb6683c505c22ab3fa11bbc43d3ce1e7dac21401d4d5a19677d348bb5f3,1998
- ansi-wl-pprint-0.6.9@sha256:f6fd6dbd4adcad0432bf75e5f5b19bb1deda00a1d8056faf18090026e577652d,2388
- colour-2.3.5@sha256:b27db0a3ad40d70bdbd8510a104269f8707592e80757a1abc66a22ba25e5a42f,1801
- hashable-1.3.0.0@sha256:4c70f1407881059e93550d3742191254296b2737b793a742bd901348fb3e1fb1,5206
- transformers-compat-0.6.5@sha256:50b00c57bf3fc379ec2477bfc261a2aebc983084488478adb29854f193af4696,5490
allow-newer: true