Merge pull request #87 from AriFordsham/ghc9

Add GHC 9 support to CI
This commit is contained in:
Greg Steuck 2021-08-12 09:58:10 -07:00 committed by GitHub
commit 74089dd58e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
44 changed files with 431 additions and 110 deletions

View File

@ -68,6 +68,23 @@ jobs:
- ~/.stack
- .stack-work
build-ghc-9.0:
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 --stack-yaml stack-9.0.yaml
- save_cache:
key: stack-cache-v2-ghc-9.0-{{ arch }}-{{ .Branch }}-{{ epoch }}
paths:
- ~/.stack
- .stack-work
build-success:
docker:
- image: circleci/rust:1.36-stretch
@ -82,9 +99,11 @@ workflows:
- build-13.23
- build-15.13
- build-ghc-8.10
- build-ghc-9.0
- build-success:
requires:
- build-12.8
- build-13.23
- build-15.13
- build-ghc-8.10
- build-ghc-9.0

View File

@ -0,0 +1,2 @@
module GHC.Driver.Monad (module GhcMonad) where
import GhcMonad

View File

@ -0,0 +1,2 @@
module GHC.Driver.Session (module DynFlags) where
import DynFlags

View File

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

View File

@ -0,0 +1,2 @@
module GHC.Plugins (module GhcPlugins) where
import GhcPlugins

View File

@ -0,0 +1,2 @@
module GHC.Tc.Types.Evidence (module TcEvidence) where
import TcEvidence

View File

@ -0,0 +1,2 @@
module GHC.Types.Basic (module BasicTypes) where
import BasicTypes

View File

@ -0,0 +1,2 @@
module GHC.Utils.Outputable (module Outputable) where
import Outputable

View File

@ -0,0 +1,2 @@
module GHC.Driver.Monad (module GhcMonad) where
import GhcMonad

View File

@ -0,0 +1,2 @@
module GHC.Driver.Session (module DynFlags) where
import DynFlags

View File

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

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

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

View File

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

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

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

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

@ -0,0 +1,2 @@
module GHC.Plugins (module GhcPlugins) where
import GhcPlugins

View File

@ -0,0 +1,2 @@
module GHC.Tc.Types.Evidence (module TcEvidence) where
import TcEvidence

View File

@ -0,0 +1,2 @@
module GHC.Types.Basic (module BasicTypes) where
import BasicTypes

View File

@ -0,0 +1,2 @@
module GHC.Utils.Outputable (module Outputable) where
import Outputable

View File

@ -13,6 +13,41 @@ import Data.Typeable (cast)
import System.Environment (getArgs)
import Text.PrettyPrint
#if MIN_VERSION_ghc(9,0,1)
import GHC.Data.FastString
import GHC.Types.Name
( Name
, isExternalName
, isInternalName
, isSystemName
, isWiredInName
, nameOccName
, nameUnique
)
import GHC.Types.Name.Occurrence
( OccName
, occNameSpace
, occNameString
, NameSpace
, varName
, dataName
, tvName
, tcClsName
)
import qualified GHC.Driver.Session as GHC
import qualified GHC.Data.FastString as GHC
import qualified GHC as GHC
import qualified GHC.Driver.Monad as GHC
import qualified GHC.Parser.Header as GHC
import qualified GHC.Parser.Lexer as GHC
import qualified GHC.Parser as Parser
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Data.StringBuffer as GHC
import GHC.Paths (libdir)
import qualified GHC.Utils.Error as Error
import GHC.Driver.Monad (liftIO)
#else
import FastString
import Name
( Name
@ -45,12 +80,16 @@ 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
import qualified ErrUtils as Error
#else
import qualified Outputable as GHC
#endif
#endif
#if MIN_VERSION_ghc(8,10,0)
import System.Exit (exitFailure)
#endif
main :: IO ()
main = do
@ -58,7 +97,11 @@ main = do
result <- parseModule f
print $ gPrint result
#if MIN_VERSION_ghc(9,0,1)
parseModule :: FilePath -> IO GHC.HsModule
#else
parseModule :: FilePath -> IO (GHC.HsModule GHC.GhcPs)
#endif
parseModule f = GHC.runGhc (Just libdir) $ do
dflags <- GHC.getDynFlags
contents <- GHC.liftIO $ GHC.stringToStringBuffer <$> readFile f
@ -70,7 +113,7 @@ parseModule f = GHC.runGhc (Just libdir) $ do
#if MIN_VERSION_ghc(8,10,0)
GHC.PFailed s -> liftIO $ do
let (_warnings, errors) = GHC.messages s dflags
ErrUtils.printBagOfErrors dflags errors
Error.printBagOfErrors dflags errors
exitFailure
#else
GHC.PFailed

View File

@ -13,4 +13,4 @@ executables:
- base
- ghc
- ghc-paths
- pretty
- pretty

View File

@ -30,7 +30,7 @@ description: |
dependencies:
- base >= 4.7 && < 5
- ghc >= 8.4 && < 8.11
- ghc >= 8.4 && < 9.2
default-extensions:
- DataKinds
@ -52,8 +52,26 @@ library:
- GHC.Hs.ImpExp
- GHC.Hs.Lit
- GHC.Hs.Pat
- GHC.Hs.Types
- GHC.Hs.Type
- GHC.Hs.Utils
- GHC.Driver.Monad
- GHC.Driver.Session
- GHC.Utils.Outputable
- GHC.Types.Basic
- GHC.Plugins
- GHC.Tc.Types.Evidence
- condition: impl(ghc>=8.10) && impl(ghc<9.0)
source-dirs: compat-8.10
other-modules:
- GHC.Hs.Type
- GHC.Driver.Monad
- GHC.Driver.Session
- GHC.Utils.Outputable
- GHC.Types.Basic
- GHC.Plugins
- GHC.Tc.Types.Evidence
source-dirs: src
other-modules:
- GHC.SourceGen.Binds.Internal
@ -73,6 +91,12 @@ tests:
- tasty >= 1.0 && < 1.5
- tasty-hunit == 0.10.*
when:
- condition: impl(ghc<9.0)
source-dirs: compat
other-modules:
- GHC.Utils.Outputable
# TODO: Fill out this test, and use it to replace pprint_examples.
pprint_test:
main: pprint_test.hs
@ -83,6 +107,14 @@ tests:
- tasty >= 1.0 && < 1.5
- tasty-hunit == 0.10.*
when:
- condition: impl(ghc<9.0)
source-dirs: compat
other-modules:
- GHC.Driver.Monad
- GHC.Driver.Session
- GHC.Utils.Outputable
name_test:
main: name_test.hs
source-dirs: tests

View File

@ -4,6 +4,7 @@
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd
{-# LANGUAGE CPP #-}
-- | This module provides combinators for constructing Haskell declarations.
module GHC.SourceGen.Binds
( -- * Bindings
@ -45,15 +46,16 @@ module GHC.SourceGen.Binds
, (<--)
) where
import BasicTypes (LexicalFixity(..))
import GHC.Types.Basic (LexicalFixity(..))
import Data.Bool (bool)
import Data.Maybe (fromMaybe)
import GHC.Hs.Binds
import GHC.Hs.Expr
import GHC.Hs.Types
import GhcPlugins (isSymOcc)
import TcEvidence (HsWrapper(WpHole))
import GHC.Hs.Type
import GHC.Plugins (isSymOcc)
#if !MIN_VERSION_ghc(9,0,1)
import GHC.Tc.Types.Evidence (HsWrapper(WpHole))
#endif
import GHC.SourceGen.Binds.Internal
import GHC.SourceGen.Name
import GHC.SourceGen.Name.Internal
@ -95,7 +97,11 @@ typeSig n = typeSigs [n]
funBindsWithFixity :: HasValBind t => Maybe LexicalFixity -> OccNameStr -> [RawMatch] -> t
funBindsWithFixity fixity name matches = bindB $ withPlaceHolder
(noExt FunBind name'
(matchGroup context matches) WpHole)
(matchGroup context matches)
#if !MIN_VERSION_ghc(9,0,1)
WpHole
#endif
)
[]
where
name' = valueRdrName $ unqual name
@ -288,7 +294,10 @@ stmt e =
-- > =====
-- > bvar "x" <-- var "act"
(<--) :: Pat' -> HsExpr' -> Stmt'
p <-- e = withPlaceHolder $ noExt BindStmt (builtPat p) (builtLoc e) noSyntaxExpr noSyntaxExpr
p <-- e = withPlaceHolder $ noExt BindStmt (builtPat p) (builtLoc e)
#if !MIN_VERSION_ghc(9,0,0)
noSyntaxExpr noSyntaxExpr
#endif
infixl 1 <--
-- | Syntax types which can declare/define pattern bindings.

View File

@ -7,12 +7,18 @@
{-# LANGUAGE CPP #-}
module GHC.SourceGen.Binds.Internal where
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (Origin(Generated))
import GHC.Data.Bag (listToBag)
import GHC.Types.SrcLoc (Located)
#else
import BasicTypes (Origin(Generated))
import Bag (listToBag)
import SrcLoc (Located)
#endif
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)
import PlaceHolder (PlaceHolder(..))

View File

@ -49,14 +49,22 @@ module GHC.SourceGen.Decl
, patSynBind
) where
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (LexicalFixity(Prefix))
import GHC.Data.Bag (listToBag)
import GHC.Types.SrcLoc (Located, LayoutInfo(..))
#else
import BasicTypes (LexicalFixity(Prefix))
import Bag (listToBag)
import SrcLoc (Located)
#endif
#if !MIN_VERSION_ghc(8,6,0)
import BasicTypes (DerivStrategy(..))
#endif
import Bag (listToBag)
import GHC.Hs.Binds
import GHC.Hs.Decls
import GHC.Hs.Types
import GHC.Hs.Type
( ConDeclField(..)
, FieldOcc(..)
, HsConDetails(..)
@ -71,8 +79,10 @@ import GHC.Hs.Types
#endif
, SrcStrictness(..)
, SrcUnpackedness(..)
#if MIN_VERSION_ghc(9,0,0)
, hsUnrestricted
#endif
)
import SrcLoc (Located)
#if MIN_VERSION_ghc(8,10,0)
import GHC.Hs.Extension (NoExtField(NoExtField))
@ -154,7 +164,9 @@ class'
class' context name vars decls
= noExt TyClD $ ClassDecl
{ tcdCtxt = builtLoc $ map builtLoc context
#if MIN_VERSION_ghc(8,10,0)
#if MIN_VERSION_ghc(9,0,0)
, tcdCExt = NoLayoutInfo
#elif MIN_VERSION_ghc(8,10,0)
, tcdCExt = NoExtField
#elif MIN_VERSION_ghc(8,6,0)
, tcdCExt = NoExt
@ -306,10 +318,10 @@ data' = newOrDataType DataType
--
-- > Foo a Int
-- > =====
-- > conDecl "Foo" [field (var "a"), field (var "Int")]
-- > prefixCon "Foo" [field (var "a"), field (var "Int")]
prefixCon :: OccNameStr -> [Field] -> ConDecl'
prefixCon name fields = renderCon98Decl name
$ PrefixCon $ map renderField fields
$ PrefixCon $ map (hsUnrestricted . renderField) fields
-- | Declares a Haskell-98-style infix constructor for a data or type
-- declaration.
@ -319,7 +331,7 @@ prefixCon name fields = renderCon98Decl name
-- > infixCon (field (var "A" @@ var "b")) ":+:" (field (Var "C" @@ var "d"))
infixCon :: Field -> OccNameStr -> Field -> ConDecl'
infixCon f name f' = renderCon98Decl name
$ InfixCon (renderField f) (renderField f')
$ InfixCon (hsUnrestricted $ renderField f) (hsUnrestricted $ renderField f')
-- | Declares Haskell-98-style record constructor for a data or type
-- declaration.
@ -371,6 +383,11 @@ strict f = f { strictness = SrcStrict }
lazy :: Field -> Field
lazy f = f { strictness = SrcLazy }
#if !MIN_VERSION_ghc(9,0,0)
hsUnrestricted :: a -> a
hsUnrestricted = id
#endif
renderField :: Field -> Located HsType'
-- TODO: parenthesizeTypeForApp is an overestimate in the case of
-- rendering an infix or record type.

View File

@ -31,9 +31,14 @@ module GHC.SourceGen.Expr
import GHC.Hs.Expr
import GHC.Hs.Extension (GhcPs)
import GHC.Hs.Pat (HsRecField'(..), HsRecFields(..))
import GHC.Hs.Types (FieldOcc(..), AmbiguousFieldOcc(..))
import GHC.Hs.Type (FieldOcc(..), AmbiguousFieldOcc(..))
import GHC.Hs.Utils (mkHsIf)
import Data.String (fromString)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc (unLoc, GenLocated(..), Located)
#else
import SrcLoc (unLoc, GenLocated(..), Located)
#endif
import GHC.SourceGen.Binds.Internal
import GHC.SourceGen.Binds
@ -68,7 +73,7 @@ lambdaCase :: [RawMatch] -> HsExpr'
lambdaCase = noExt HsLamCase . matchGroup CaseAlt
if' :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
if' x y z = noExt HsIf Nothing (builtLoc x) (builtLoc y) (builtLoc z)
if' x y z = mkHsIf (builtLoc x) (builtLoc y) (builtLoc z)
-- | A MultiWayIf expression.
--
@ -94,7 +99,12 @@ multiIf = noExtOrPlaceHolder HsMultiIf . map builtLoc
-- > =====
-- > do' [bvar "x" <-- var "act", stmt $ var "return" @@ var "x"]
do' :: [Stmt'] -> HsExpr'
do' = withPlaceHolder . noExt HsDo DoExpr
do' = withPlaceHolder
#if MIN_VERSION_ghc(9,0,0)
. noExt HsDo (DoExpr Nothing)
#else
. noExt HsDo DoExpr
#endif
. builtLoc . map (builtLoc . parenthesizeIfLet)
where
-- Put parentheses around a "let" in a do-binding, to avoid:
@ -120,7 +130,12 @@ do' = withPlaceHolder . noExt HsDo DoExpr
-- > ]
listComp :: HsExpr' -> [Stmt'] -> HsExpr'
listComp lastExpr stmts =
let lastStmt = noExt LastStmt (builtLoc lastExpr) False noSyntaxExpr
let lastStmt = noExt LastStmt (builtLoc lastExpr) ret noSyntaxExpr
#if MIN_VERSION_ghc(9,0,0)
ret = Nothing
#else
ret = False
#endif
in withPlaceHolder . noExt HsDo ListComp . builtLoc . map builtLoc $
stmts ++ [lastStmt]

View File

@ -8,7 +8,11 @@
module GHC.SourceGen.Expr.Internal where
import GHC.Hs.Expr
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc (Located, unLoc)
#else
import SrcLoc (Located, unLoc)
#endif
import GHC.SourceGen.Lit.Internal
import GHC.SourceGen.Syntax.Internal

View File

@ -6,6 +6,7 @@
-- | This module provides combinators for constructing Haskell literals,
-- which may be used in either patterns or expressions.
{-# LANGUAGE CPP #-}
module GHC.SourceGen.Lit
( HsLit'
, HsOverLit'
@ -16,12 +17,16 @@ module GHC.SourceGen.Lit
, frac
) where
import BasicTypes (FractionalLit(..))
import BasicTypes(IntegralLit(..), SourceText(..))
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (FractionalLit(..), IntegralLit(..), SourceText(..))
import GHC.Data.FastString (fsLit)
#else
import BasicTypes (FractionalLit(..), IntegralLit(..), SourceText(..))
import FastString (fsLit)
#endif
import GHC.Hs.Lit
import GHC.Hs.Expr (noExpr, noSyntaxExpr, HsExpr(..))
import GHC.Hs.Pat (Pat(..))
import FastString (fsLit)
import GHC.SourceGen.Lit.Internal
import GHC.SourceGen.Syntax.Internal

View File

@ -4,10 +4,14 @@
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd
{-# LANGUAGE CPP #-}
module GHC.SourceGen.Lit.Internal where
import BasicTypes (SourceText(NoSourceText), FractionalLit(..))
import BasicTypes (IntegralLit(..))
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (SourceText(NoSourceText), FractionalLit(..), IntegralLit(..))
#else
import BasicTypes (SourceText(NoSourceText), FractionalLit(..), IntegralLit(..))
#endif
import GHC.Hs.Lit
import GHC.SourceGen.Syntax.Internal

View File

@ -34,7 +34,13 @@ import GHC.Hs
, ImportDeclQualifiedStyle(..)
#endif
)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc (LayoutInfo(..))
import GHC.Unit.Module (IsBootInterface(..))
import GHC.Types.Name.Reader (RdrName)
#else
import RdrName (RdrName)
#endif
import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Name
@ -54,6 +60,9 @@ module' name exports imports decls = HsModule
, hsmodDecls = fmap builtLoc decls
, hsmodDeprecMessage = Nothing
, hsmodHaddockModHeader = Nothing
#if MIN_VERSION_ghc(9,0,0)
, hsmodLayout = NoLayoutInfo
#endif
}
qualified' :: ImportDecl' -> ImportDecl'
@ -71,7 +80,13 @@ as' d m = d { ideclAs = Just (builtLoc $ unModuleNameStr m) }
import' :: ModuleNameStr -> ImportDecl'
import' m = noSourceText (noExt ImportDecl)
(builtLoc $ unModuleNameStr m)
Nothing False False
Nothing
#if MIN_VERSION_ghc(9,0,0)
NotBoot
#else
False
#endif
False
#if MIN_VERSION_ghc(8,10,0)
NotQualified
#else
@ -89,7 +104,13 @@ hiding d ies = d
-- | Adds the @{-# SOURCE #-}@ pragma to an import.
source :: ImportDecl' -> ImportDecl'
source d = d { ideclSource = True }
source d = d { ideclSource =
#if MIN_VERSION_ghc(9,0,0)
IsBoot
#else
True
#endif
}
-- | Exports all methods and/or constructors.
--

View File

@ -9,6 +9,7 @@
--
-- These types are all instances of 'Data.String.IsString'. For ease of use,
-- we recommend enabling the @OverloadedStrings@ extension.
{-# LANGUAGE CPP #-}
module GHC.SourceGen.Name
( -- * RdrNameStr
RdrNameStr(..)
@ -27,11 +28,18 @@ module GHC.SourceGen.Name
, moduleNameStrToString
) where
#if MIN_VERSION_ghc(9,0,0)
import GHC.Data.FastString (unpackFS)
import GHC.Unit.Module (moduleNameString)
import GHC.Types.Name.Occurrence (OccName, occNameFS, occNameSpace, isVarNameSpace)
import GHC.Types.Name (Name, nameOccName)
#else
import FastString (unpackFS)
import Module (moduleNameString)
import GHC.SourceGen.Name.Internal
import OccName (OccName, occNameFS, occNameSpace, isVarNameSpace)
import Name (Name, nameOccName)
#endif
import GHC.SourceGen.Name.Internal
unqual :: OccNameStr -> RdrNameStr
unqual = UnqualStr

View File

@ -4,16 +4,25 @@
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd
{-# LANGUAGE CPP #-}
module GHC.SourceGen.Name.Internal where
import Data.Char (isAlphaNum, isUpper)
import Data.List (intercalate)
import Data.String (IsString(..))
#if MIN_VERSION_ghc(9,0,0)
import GHC.Data.FastString (FastString, fsLit)
import GHC.Unit.Module (mkModuleNameFS, ModuleName, moduleNameString)
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc (Located)
#else
import FastString (FastString, fsLit)
import Module (mkModuleNameFS, ModuleName, moduleNameString)
import RdrName
import OccName
import RdrName
import SrcLoc (Located)
#endif
import GHC.SourceGen.Syntax.Internal (builtLoc)

View File

@ -18,8 +18,7 @@ module GHC.SourceGen.Overloaded
, BVar(..)
) where
import BasicTypes (Boxity(..))
import GHC.Hs.Types
import GHC.Hs.Type
( HsType(..)
, HsTyVarBndr(..)
)
@ -34,10 +33,20 @@ import GHC.Hs
, HsTupArg(..)
, HsTupleSort(..)
)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (Boxity(..))
import GHC.Core.DataCon (dataConName)
import GHC.Types.Name.Reader (RdrName(..), nameRdrName)
import GHC.Types.SrcLoc (Located)
import GHC.Builtin.Types (consDataCon_RDR, nilDataCon, unitDataCon)
import GHC.Types.Var (Specificity(..))
#else
import BasicTypes (Boxity(..))
import DataCon (dataConName)
import RdrName (RdrName(..), nameRdrName)
import SrcLoc (Located)
import TysWiredIn (consDataCon_RDR, nilDataCon, unitDataCon)
#endif
import GHC.SourceGen.Expr.Internal
import GHC.SourceGen.Name.Internal
@ -241,8 +250,16 @@ instance Var HsType' where
instance BVar HsType' where
bvar = var . UnqualStr
#if MIN_VERSION_ghc(9,0,0)
instance BVar HsTyVarBndr' where
bvar = noExt UserTyVar () . typeRdrName . UnqualStr
instance BVar HsTyVarBndrS' where
bvar = noExt UserTyVar SpecifiedSpec . typeRdrName . UnqualStr
#else
instance BVar HsTyVarBndr' where
bvar = noExt UserTyVar . typeRdrName . UnqualStr
#endif
instance Var IE' where
var n = noExt IEVar $ builtLoc $ IEName $ exportRdrName n

View File

@ -18,13 +18,13 @@ module GHC.SourceGen.Pat
, sigP
) where
import GHC.Hs.Types
import GHC.Hs.Type
import GHC.Hs.Pat hiding (LHsRecField')
import GHC.SourceGen.Name.Internal
import GHC.SourceGen.Pat.Internal
import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Type.Internal (sigWcType)
import GHC.SourceGen.Type.Internal (patSigType)
-- | A wild pattern (@_@).
wildP :: Pat'
@ -44,7 +44,13 @@ v `asP` p = noExt AsPat (valueRdrName v) $ builtPat $ parenthesize p
-- > =====
-- > conP "A" [bvar "b", bvar "c"]
conP :: RdrNameStr -> [Pat'] -> Pat'
conP c xs = ConPatIn (valueRdrName c) $ PrefixCon
conP c xs =
#if MIN_VERSION_ghc(9,0,0)
noExt ConPat
#else
ConPatIn
#endif
(valueRdrName c) $ PrefixCon
$ map (builtPat . parenthesize) xs
-- | A pattern constructor with no arguments.
@ -56,8 +62,13 @@ conP_ :: RdrNameStr -> Pat'
conP_ c = conP c []
recordConP :: RdrNameStr -> [(RdrNameStr, Pat')] -> Pat'
recordConP c fs
= ConPatIn (valueRdrName c)
recordConP c fs =
#if MIN_VERSION_ghc(9,0,0)
noExt ConPat
#else
ConPatIn
#endif
(valueRdrName c)
$ RecCon $ HsRecFields (map mkRecField fs) Nothing -- No ".."
where
mkRecField :: (RdrNameStr, Pat') -> LHsRecField' LPat'
@ -92,9 +103,9 @@ 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 (builtPat p) (sigWcType t)
sigP p t = noExt SigPat (builtPat p) (patSigType t)
#elif MIN_VERSION_ghc(8,6,0)
sigP p t = SigPat (sigWcType t) (builtPat p)
sigP p t = SigPat (patSigType t) (builtPat p)
#else
sigP p t = SigPatIn (builtPat p) (sigWcType t)
sigP p t = SigPatIn (builtPat p) (patSigType t)
#endif

View File

@ -2,11 +2,16 @@
module GHC.SourceGen.Pat.Internal where
import GHC.Hs.Pat (Pat(..))
import GHC.Hs.Types (HsConDetails(..))
#if MIN_VERSION_ghc(9,0,0)
import GHC.Hs.Type (HsConDetails(..))
import GHC.Types.SrcLoc (unLoc)
#else
import GHC.Hs.Type (HsConDetails(..))
import SrcLoc (unLoc)
#endif
import GHC.SourceGen.Lit.Internal (litNeedsParen, overLitNeedsParen)
import GHC.SourceGen.Syntax.Internal
import SrcLoc (unLoc)
-- Note: GHC>=8.6 inserts parentheses automatically when pretty-printing patterns.
-- When we stop supporting lower versions, we may be able to simplify this.
@ -24,9 +29,14 @@ needsPar (NPat _ l _ _) = overLitNeedsParen $ unLoc l
needsPar (LitPat l) = litNeedsParen l
needsPar (NPat l _ _ _) = overLitNeedsParen $ unLoc l
#endif
#if MIN_VERSION_ghc(9,0,0)
needsPar (ConPat _ _ (PrefixCon xs)) = not $ null xs
needsPar (ConPat _ _ (InfixCon _ _)) = True
#else
needsPar (ConPatIn _ (PrefixCon xs)) = not $ null xs
needsPar (ConPatIn _ (InfixCon _ _)) = True
needsPar ConPatOut{} = True
#endif
#if MIN_VERSION_ghc(8,6,0)
needsPar SigPat{} = True
#else

View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
@ -11,15 +12,19 @@ module GHC.SourceGen.Pretty
, hPutPpr
) where
import DynFlags
import GhcMonad
import Outputable
import GHC.Driver.Monad
import GHC.Driver.Session
import GHC.Utils.Outputable
import System.IO
hPutPpr :: Outputable a => Handle -> a -> Ghc ()
hPutPpr h x = do
dflags <- getDynFlags
liftIO $ printForUser dflags h neverQualify $ ppr x
liftIO $ printForUser dflags h neverQualify
#if MIN_VERSION_ghc(9,0,1)
AllTheWay
#endif
$ ppr x
putPpr :: Outputable a => a -> Ghc ()
putPpr = hPutPpr stdout

View File

@ -38,6 +38,9 @@ import GHC.Hs
#if !MIN_VERSION_ghc(8,8,0)
, LHsRecField
, LHsRecUpdField
#endif
#if MIN_VERSION_ghc(9,0,0)
, HsPatSigType
#endif
)
import GHC.Hs.Binds (Sig, HsLocalBinds)
@ -48,13 +51,19 @@ import BasicTypes (DerivStrategy)
#endif
import GHC.Hs.Decls (HsDerivingClause)
import GHC.Hs.Pat
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc (SrcSpan, Located, GenLocated(..), mkGeneralSrcSpan)
#else
import RdrName (RdrName)
import SrcLoc (SrcSpan, Located, GenLocated(..), mkGeneralSrcSpan)
#endif
#if MIN_VERSION_ghc(8,8,0)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (PromotionFlag(..))
#elif MIN_VERSION_ghc(8,8,0)
import BasicTypes (PromotionFlag(..))
#else
import GHC.Hs.Types (Promoted(..))
import GHC.Hs.Type (Promoted(..))
#endif
#if MIN_VERSION_ghc(8,10,0)
@ -65,6 +74,10 @@ import GHC.Hs.Extension (NoExt(NoExt))
import PlaceHolder(PlaceHolder(..))
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Var (Specificity)
#endif
import GHC.Hs.Extension (GhcPs)
#if MIN_VERSION_ghc(8,6,0)
@ -194,15 +207,29 @@ type IE' = IE GhcPs
-- Instances:
--
-- * 'GHC.SourceGen.Overloaded.BVar'
#if MIN_VERSION_ghc(9,0,0)
type HsTyVarBndr' = HsTyVarBndr () GhcPs
type HsTyVarBndrS' = HsTyVarBndr Specificity GhcPs
#else
type HsTyVarBndr' = HsTyVarBndr GhcPs
type HsTyVarBndrS' = HsTyVarBndr GhcPs
#endif
type HsLit' = HsLit GhcPs
#if MIN_VERSION_ghc(9,0,0)
type HsModule' = HsModule
#else
type HsModule' = HsModule GhcPs
#endif
type HsBind' = HsBind GhcPs
type HsLocalBinds' = HsLocalBinds GhcPs
type HsValBinds' = HsValBinds GhcPs
type Sig' = Sig GhcPs
#if MIN_VERSION_ghc(9,0,0)
type HsMatchContext' = HsMatchContext GhcPs
#else
type HsMatchContext' = HsMatchContext RdrName
#endif
type Match' = Match GhcPs
type MatchGroup' = MatchGroup GhcPs
type GRHS' = GRHS GhcPs
@ -228,3 +255,9 @@ type DerivStrategy' = DerivStrategy GhcPs
#else
type DerivStrategy' = DerivStrategy
#endif
#if MIN_VERSION_ghc(9,0,0)
type HsPatSigType' = HsPatSigType GhcPs
#else
type HsPatSigType' = LHsSigWcType'
#endif

View File

@ -22,7 +22,12 @@ module GHC.SourceGen.Type
) where
import Data.String (fromString)
import GHC.Hs.Types
#if MIN_VERSION_ghc(9,0,0)
import GHC.Hs.Type
import GHC.Parser.Annotation
#else
import GHC.Hs.Type
#endif
import GHC.SourceGen.Syntax.Internal
import GHC.SourceGen.Lit.Internal (noSourceText)
@ -56,7 +61,11 @@ tuplePromotedTy = withPlaceHolders (noExt HsExplicitTupleTy) . map builtLoc
-- > =====
-- > var "a" --> var "b"
(-->) :: HsType' -> HsType' -> HsType'
a --> b = noExt HsFunTy (parenthesizeTypeForFun $ builtLoc a) (builtLoc b)
a --> b = noExt HsFunTy
#if MIN_VERSION_ghc(9,0,0)
(HsUnrestrictedArrow NormalSyntax)
#endif
(parenthesizeTypeForFun $ builtLoc a) (builtLoc b)
infixr 0 -->
@ -65,12 +74,17 @@ infixr 0 -->
-- > forall a . T a
-- > =====
-- > forall' [bvar "a"] $ var "T" @@ var "a"
forall' :: [HsTyVarBndr'] -> HsType' -> HsType'
forall' :: [HsTyVarBndrS'] -> HsType' -> HsType'
forall' ts = noExt HsForAllTy
#if MIN_VERSION_ghc(9,0,0)
(mkHsForAllInvisTele (map builtLoc ts))
#else
#if MIN_VERSION_ghc(8,10,0)
ForallInvis -- "Invisible" forall, i.e., with a dot
#endif
(map builtLoc ts) . builtLoc
(map builtLoc ts)
#endif
. builtLoc
-- | Qualify a type with constraints.
--
@ -88,5 +102,8 @@ infixr 0 ==>
-- > =====
-- > kindedVar "x" (var "A")
kindedVar :: OccNameStr -> HsType' -> HsTyVarBndr'
kindedVar v t = noExt KindedTyVar (typeRdrName $ UnqualStr v)
(builtLoc t)
kindedVar v t = noExt KindedTyVar
#if MIN_VERSION_ghc(9,0,0)
()
#endif
(typeRdrName $ UnqualStr v) (builtLoc t)

View File

@ -7,8 +7,13 @@
{-# LANGUAGE CPP #-}
module GHC.SourceGen.Type.Internal where
import GHC.Hs.Types as Types
#if MIN_VERSION_ghc(9,0,0)
import GHC.Hs.Type as Types
import GHC.Types.SrcLoc (Located, unLoc)
#else
import GHC.Hs.Type as Types
import SrcLoc (Located, unLoc)
#endif
import GHC.SourceGen.Syntax.Internal
@ -62,3 +67,10 @@ sigWcType = noExt (withPlaceHolder Types.HsWC) . sigType
wcType :: HsType' -> LHsWcType'
wcType = noExt (withPlaceHolder Types.HsWC) . builtLoc
patSigType :: HsType' -> HsPatSigType'
#if MIN_VERSION_ghc(9,0,0)
patSigType = mkHsPatSigType . builtLoc
#else
patSigType = sigWcType
#endif

View File

@ -1,43 +0,0 @@
# 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

34
stack-9.0.yaml Normal file
View File

@ -0,0 +1,34 @@
# 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-9.0.1
packages:
- .
- ghc-show-ast
allow-newer: true
ghc-options:
"$locals": -Wall -Werror
extra-deps:
- QuickCheck-2.14.2@sha256:4ce29211223d5e6620ebceba34a3ca9ccf1c10c0cf387d48aea45599222ee5aa,7736
- ghc-paths-0.1.0.12@sha256:afdfdb6584f39e821b2b7130e12007bf3ad87401d86f5105eead059c150dc81d,657
- tasty-1.4.1@sha256:69e90e965543faf0fc2c8e486d6c1d8cf81fd108e2c4541234c41490f392f94f,2638
- tasty-hunit-0.10.0.3@sha256:ba774024f3a26100c559dbef41e030bdf443408ed848691f7b9aa85b6fb218c3,1545
- tasty-quickcheck-0.10.1.2@sha256:45c8125e5de19570359784def5946dec759b7431e3beccc61cd09d661daf19ed,1613
- ansi-terminal-0.11@sha256:97470250c92aae14c4c810d7f664c532995ba8910e2ad797b29f22ad0d2d0194,3307
- call-stack-0.4.0@sha256:ac44d2c00931dc20b01750da8c92ec443eb63a7231e8550188cb2ac2385f7feb,1200
- clock-0.8.2@sha256:473ffd59765cc67634bdc55b63c699a85addf3a024089073ec2a862881e83e2a,4313
- optparse-applicative-0.16.1.0@sha256:16ebd7054b2265c1aad16c1d19dc503695fbfc67b35203d9952fd577d08c0110,4982
- random-1.2.0@sha256:195506fedaa7c31c1fa2a747e9b49b4a5d1f0b09dd8f1291f23a771656faeec3,6097
- splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049
- tagged-0.8.6.1@sha256:29c67d98a4404607f024750ab9c7210dadcbbef4e1944c48c52902f2071b2662,2874
- unbounded-delays-0.1.1.1@sha256:d7a2a49f15bdff2a8bdbd76f9d204580ea4be5a9def500c6371d51d8111cbcbe,1209
- wcwidth-0.0.2@sha256:77531eb6683c505c22ab3fa11bbc43d3ce1e7dac21401d4d5a19677d348bb5f3,1998
- ansi-wl-pprint-0.6.9@sha256:20d30674f137d43aa0279c2c2cc5e45a5f1c3c57e301852494906158b6313bf7,2388
- colour-2.3.6@sha256:ebdcbf15023958838a527e381ab3c3b1e99ed12d1b25efeb7feaa4ad8c37664a,2378
- transformers-compat-0.7@sha256:c4cc2d01c4e490ba680e9a0b607a1a790137856a6b3af12f8bdc7788a567bcf5,5572

View File

@ -4,7 +4,7 @@
# license that can be found in the LICENSE file or at
# https://developers.google.com/open-source/licenses/bsd
resolver: lts-15.13
resolver: lts-18.3
packages:
- .
- ghc-show-ast

View File

@ -1,9 +1,14 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Main (main) where
import GHC.SourceGen.Name
#if MIN_VERSION_ghc(9,0,1)
import GHC.Types.Name.Occurrence
#else
import OccName
#endif
import Data.List (intercalate)
import Data.String (fromString)

View File

@ -11,7 +11,7 @@ module Main (main) where
import GHC.Paths (libdir)
import GHC (runGhc)
import Outputable (Outputable)
import GHC.Utils.Outputable (Outputable)
import GHC.SourceGen

View File

@ -1,11 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
module Main(main) where
import DynFlags (getDynFlags)
import GhcMonad (liftIO)
import GHC.Driver.Session (getDynFlags)
import GHC.Driver.Monad (liftIO)
import GHC.Paths (libdir)
import GHC (runGhc, DynFlags)
import Outputable (Outputable)
import GHC.Utils.Outputable (Outputable)
import Test.Tasty
import Test.Tasty.HUnit