Drop support for GHC < 8.0

This commit is contained in:
Erik de Castro Lopo 2018-08-28 17:51:43 +10:00
parent 6919aa67d4
commit 18e108811f
8 changed files with 29 additions and 160 deletions

View File

@ -7,12 +7,10 @@ module IHaskellPrelude (
Data.Typeable.Typeable,
Data.Typeable.cast,
#if MIN_VERSION_ghc(7,8,0)
Data.Typeable.Proxy,
GHC.Exts.IsString,
GHC.Exts.IsList,
#endif
System.IO.hPutStrLn,
System.IO.hPutStr,
@ -78,13 +76,7 @@ import GHC.Enum as X
import GHC.Num as X
import GHC.Real as X
import GHC.Err as X hiding (absentErr)
#if MIN_VERSION_ghc(8,0,0)
import GHC.Base as X hiding (Any, mapM, foldr, sequence, many, (<|>), Module(..))
#elif MIN_VERSION_ghc(7,10,0)
import GHC.Base as X hiding (Any, mapM, foldr, sequence, many, (<|>))
#else
import GHC.Base as X hiding (Any)
#endif
import Data.List as X hiding (head, last, tail, init, transpose, subsequences, permutations,
foldl, foldl1, maximum, minimum, scanl, scanl1, scanr, scanr1,
span, break, mapAccumL, mapAccumR, dropWhileEnd, (!!),

View File

@ -22,9 +22,7 @@ import System.Process (readProcess, readProcessWithExitCode)
import System.Exit (exitSuccess, ExitCode(ExitSuccess))
import Control.Exception (try, SomeException)
import System.Environment (getArgs)
#if MIN_VERSION_ghc(7,8,0)
import System.Environment (setEnv)
#endif
import System.Posix.Signals
import qualified Data.Map as Map
import qualified Data.Text.Encoding as E
@ -142,7 +140,6 @@ runKernel kernelOpts profileSrc = do
dir <- getIHaskellDir
Stdin.recordKernelProfile dir profile
#if MIN_VERSION_ghc(7,8,0)
when useStack $ do
-- Detect if we have stack
runResult <- try $ readProcessWithExitCode "stack" [] ""
@ -160,7 +157,6 @@ runKernel kernelOpts profileSrc = do
in case tailMay val of
Nothing -> return ()
Just val' -> setEnv var val'
#endif
-- Serve on all sockets and ports defined in the profile.
interface <- serveProfile profile debug

View File

@ -31,7 +31,7 @@ import System.Environment (getEnv)
import GHC hiding (Qualified)
#if MIN_VERSION_ghc(8,2,0)
import GHC.PackageDb
#elif MIN_VERSION_ghc(7,10,0)
#else
import GHC.PackageDb (ExposedModule(exposedName))
#endif
import DynFlags
@ -63,16 +63,14 @@ data CompletionType = Empty
| KernelOption String
| Extension String
deriving (Show, Eq)
#if MIN_VERSION_ghc(8,2,0)
exposedName :: (a, b) -> a
exposedName = fst
#endif
#if MIN_VERSION_ghc(7,10,0)
extName (FlagSpec { flagSpecName = name }) = name
#else
extName (name, _, _) = name
exposedName = id
#endif
extName (FlagSpec { flagSpecName = name }) = name
complete :: String -> Int -> Interpreter (String, [String])
complete code posOffset = do
-- Get the line of code which is being completed and offset within that line
@ -93,11 +91,7 @@ complete code posOffset = do
let Just db = pkgDatabase flags
getNames = map (moduleNameString . exposedName) . exposedModules
#if MIN_VERSION_ghc(8,0,0)
moduleNames = nub $ concatMap getNames $ concatMap snd db
#else
moduleNames = nub $ concatMap getNames db
#endif
let target = completionTarget line pos
completion = completionType line pos target
@ -127,17 +121,12 @@ complete code posOffset = do
return $ filter (prefix `isPrefixOf`) moduleNames
DynFlag ext -> do
-- Possibly leave out the fLangFlags? The -XUndecidableInstances vs. obsolete
-- -fallow-undecidable-instances.
-- Possibly leave out the fLangFlags?
let kernelOptNames = concatMap getSetName kernelOpts
otherNames = ["-package", "-Wall", "-w"]
fNames = map extName fFlags ++
#if MIN_VERSION_ghc(8,0,0)
map extName wWarningFlags ++
#else
map extName fWarningFlags ++
#endif
map extName fLangFlags
fNoNames = map ("no" ++) fNames
fAllNames = map ("-f" ++) (fNames ++ fNoNames)

View File

@ -65,11 +65,7 @@ import qualified Linker
import TcType
import Unify
import InstEnv
#if MIN_VERSION_ghc(7, 8, 0)
import GhcMonad (liftIO, withSession)
#else
import GhcMonad (withSession)
#endif
import GHC hiding (Stmt, TypeSig)
import Exception hiding (evaluate)
import Outputable hiding ((<>))
@ -126,12 +122,7 @@ write :: (MonadIO m, GhcMonad m) => KernelState -> String -> m ()
write state x = when (kernelDebug state) $ liftIO $ hPutStrLn stderr $ "DEBUG: " ++ x
type Interpreter = Ghc
#if MIN_VERSION_ghc(7, 8, 0)
-- GHC 7.8 exports a MonadIO instance for Ghc
#else
instance MonadIO.MonadIO Interpreter where
liftIO = MonadUtils.liftIO
#endif
requiredGlobalImports :: [String]
requiredGlobalImports =
[ "import qualified Prelude as IHaskellPrelude"
@ -194,23 +185,13 @@ packageIdString' dflags pkg_cfg =
Just cfg -> let
PackageName name = packageName cfg
in unpackFS name
#elif MIN_VERSION_ghc(8,0,0)
fromMaybe "(unknown)" (unitIdPackageIdString dflags $ packageConfigId pkg_cfg)
#elif MIN_VERSION_ghc(7,10,2)
fromMaybe "(unknown)" (packageKeyPackageIdString dflags $ packageConfigId pkg_cfg)
#elif MIN_VERSION_ghc(7,10,0)
packageKeyPackageIdString dflags . packageConfigId
#else
packageIdString . packageConfigId
fromMaybe "(unknown)" (unitIdPackageIdString dflags $ packageConfigId pkg_cfg)
#endif
getPackageConfigs :: DynFlags -> [PackageConfig]
getPackageConfigs dflags =
#if MIN_VERSION_ghc(8,0,0)
foldMap snd pkgDb
#else
pkgDb
#endif
where
Just pkgDb = pkgDatabase dflags
@ -236,10 +217,6 @@ initializeImports = do
iHaskellPkgName = initStr ++ intercalate "." (map show (versionBranch version))
#endif
#if !MIN_VERSION_ghc(8,0,0)
unitId = packageId
#endif
dependsOnRight pkg = not $ null $ do
pkg <- db
depId <- depends pkg
@ -449,11 +426,7 @@ flushWidgetMessages state evalMsgs widgetHandler = do
getErrMsgDoc :: ErrUtils.ErrMsg -> SDoc
#if MIN_VERSION_ghc(8,0,0)
getErrMsgDoc = ErrUtils.pprLocErrMsg
#else
getErrMsgDoc msg = ErrUtils.errMsgShortString msg $$ ErrUtils.errMsgContext msg
#endif
safely :: KernelState -> Interpreter EvalOut -> Interpreter EvalOut
safely state = ghandle handler . ghandle sourceErrorHandler
@ -1083,11 +1056,7 @@ doLoadModule name modName = do
setSessionDynFlags $ flip gopt_set Opt_BuildDynamicToo
flags
{ hscTarget = objTarget flags
#if MIN_VERSION_ghc(8,0,0)
, log_action = \dflags sev srcspan ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :)
#else
, log_action = \dflags sev srcspan ppr msg -> modifyIORef' errRef (showSDoc flags msg :)
#endif
}
-- Load the new target.
@ -1138,11 +1107,9 @@ doLoadModule name modName = do
initializeItVariable
return $ displayError $ "Failed to load module " ++ modName ++ ": " ++ show exception
#if MIN_VERSION_ghc(7,8,0)
objTarget flags = defaultObjectTarget $ targetPlatform flags
#else
objTarget flags = defaultObjectTarget
#endif
keepingItVariable :: Interpreter a -> Interpreter a
keepingItVariable act = do
-- Generate the it variable temp name
@ -1217,7 +1184,6 @@ capturedEval output stmt = do
-- Initialize evaluation context.
results <- forM initStmts goStmt
#if __GLASGOW_HASKELL__ >= 800
-- This works fine on GHC 8.0 and newer
dyn <- dynCompileExpr readVariable
pipe <- case fromDynamic dyn of
@ -1226,26 +1192,7 @@ capturedEval output stmt = do
handle <- fdToHandle fd
hSetEncoding handle utf8
return handle
#else
-- Get the pipe to read printed output from. This is effectively the source code of dynCompileExpr
-- from GHC API's InteractiveEval. However, instead of using a `Dynamic` as an intermediary, it just
-- directly reads the value. This is incredibly unsafe! However, for some reason the `getContext`
-- and `setContext` required by dynCompileExpr (to import and clear Data.Dynamic) cause issues with
-- data declarations being updated (e.g. it drops newer versions of data declarations for older ones
-- for unknown reasons). First, compile down to an HValue.
let pipeExpr = printf "let %s = %s" (var "pipe_var_") readVariable
Just (_, hValues, _) <- withSession $ liftIO . flip hscStmt pipeExpr
-- Then convert the HValue into an executable bit, and read the value.
pipe <- liftIO $ do
fds <- unsafeCoerce hValues
fd <- case fds of
fd : _ -> return fd
[] -> fail "Failed to evaluate pipes"
_ -> fail $ "Expected one fd, saw "++show (length fds)
handle <- fdToHandle fd
hSetEncoding handle utf8
return handle
#endif
-- Keep track of whether execution has completed.
completed <- liftIO $ newMVar False
finishedReading <- liftIO newEmptyMVar

View File

@ -91,11 +91,7 @@ extensionFlag ext =
-- Check if a FlagSpec matches "No<ExtensionName>". In that case, we disable the extension.
flagMatchesNo ext fs = ext == "No" ++ flagSpecName fs
#if !MIN_VERSION_ghc(7,10,0)
flagSpecName (name, _, _) = name
flagSpecFlag (_, flag, _) = flag
#endif
-- | Pretty-print dynamic flags (taken from 'InteractiveUI' module of `ghc-bin`)
pprDynFlags :: Bool -- ^ Whether to include flags which are on by default
-> DynFlags
@ -111,17 +107,10 @@ pprDynFlags show_all dflags =
]
where
#if MIN_VERSION_ghc(8,0,0)
warningFlags = DynFlags.wWarningFlags
#else
warningFlags = DynFlags.fWarningFlags
#endif
#if MIN_VERSION_ghc(7,8,0)
opt = gopt
#else
opt = dopt
#endif
setting test flag
| quiet = O.empty :: O.SDoc
| is_on = fstr name :: O.SDoc
@ -150,11 +139,8 @@ pprDynFlags show_all dflags =
flgs = concat [flgs1, flgs2, flgs3]
flgs1 = [Opt_PrintExplicitForalls]
#if MIN_VERSION_ghc(7,8,0)
flgs2 = [Opt_PrintExplicitKinds]
#else
flgs2 = []
#endif
flgs3 = [Opt_PrintBindResult, Opt_BreakOnException, Opt_BreakOnError, Opt_PrintEvldWithShow]
-- | Pretty-print the base language and active options (taken from `InteractiveUI` module of
@ -395,21 +381,11 @@ cleanUpDuplicateInstances = modifySession $ \hscEnv ->
in hscEnv { hsc_IC = ic { ic_instances = (clsInsts', famInsts) } }
where
instEq :: ClsInst -> ClsInst -> Bool
#if MIN_VERSION_ghc(8,0,0)
-- Only support replacing instances on GHC 7.8 and up
instEq c1 c2
| ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys, is_cls = cls } <- c1,
ClsInst { is_tys = tpl_tys', is_cls = cls' } <- c2
= cls == cls' && isJust (tcMatchTys tpl_tys tpl_tys')
#elif MIN_VERSION_ghc(7,8,0)
instEq c1 c2
| ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys, is_cls = cls } <- c1,
ClsInst { is_tys = tpl_tys', is_cls = cls' } <- c2
= let tpl_tv_set = mkVarSet tpl_tvs
in cls == cls' && isJust (tcMatchTys tpl_tv_set tpl_tys tpl_tys')
#else
instEq _ _ = False
#endif
-- | Get the type of an expression and convert it to a string.
@ -450,18 +426,12 @@ getDescription str = do
where
#if MIN_VERSION_ghc(7,8,0)
getInfo' = getInfo False
#else
getInfo' = getInfo
#endif
#if MIN_VERSION_ghc(8,4,0)
getType (theType, _, _, _, _) = theType
#elif MIN_VERSION_ghc(7,8,0)
getType (theType, _, _, _) = theType
#else
getType (theType, _, _) = theType
getType (theType, _, _, _) = theType
#endif
#if MIN_VERSION_ghc(8,4,0)
@ -470,16 +440,12 @@ getDescription str = do
showFixity thing fixity O.$$
O.vcat (map GHC.pprInstance classInstances) O.$$
O.vcat (map GHC.pprFamInst famInstances)
#elif MIN_VERSION_ghc(7,8,0)
#else
printInfo (thing, fixity, classInstances, famInstances) =
pprTyThingInContextLoc thing O.$$
showFixity thing fixity O.$$
O.vcat (map GHC.pprInstance classInstances) O.$$
O.vcat (map GHC.pprFamInst famInstances)
#else
printInfo (thing, fixity, classInstances) =
pprTyThingInContextLoc False thing O.$$ showFixity thing fixity O.$$
O.vcat (map GHC.pprInstance classInstances)
#endif
showFixity thing fixity =
if fixity == GHC.defaultFixity

View File

@ -8,12 +8,10 @@ module IHaskellPrelude (
Data.Typeable.Typeable,
Data.Typeable.cast,
#if MIN_VERSION_ghc(7,8,0)
Data.Typeable.Proxy,
GHC.Exts.IsString,
GHC.Exts.IsList,
#endif
System.IO.hPutStrLn,
System.IO.hPutStr,
@ -80,13 +78,7 @@ import GHC.Enum as X
import GHC.Num as X
import GHC.Real as X
import GHC.Err as X hiding (absentErr)
#if MIN_VERSION_ghc(8,0,0)
import GHC.Base as X hiding (Any, mapM, foldr, sequence, many, (<|>), Module(..))
#elif MIN_VERSION_ghc(7,10,0)
import GHC.Base as X hiding (Any, mapM, foldr, sequence, many, (<|>))
#else
import GHC.Base as X hiding (Any)
#endif
import Data.List as X hiding (head, last, tail, init, transpose, subsequences, permutations,
foldl, foldl1, maximum, minimum, scanl, scanl1, scanr, scanr1,
span, break, mapAccumL, mapAccumR, dropWhileEnd, (!!),

View File

@ -89,14 +89,7 @@ pages string expected = evaluationComparing comparison string
Nothing -> dropScriptTag $ tail str
fixQuotes :: String -> String
#if MIN_VERSION_ghc(7, 8, 0)
fixQuotes = id
#else
fixQuotes = map $ \char -> case char of
'\8216' -> '`'
'\8217' -> '\''
c -> c
#endif
testEval :: Spec

View File

@ -234,10 +234,4 @@ testParseString = describe "Parser" $ do
|]) >>= (`shouldBe` [Located 2 (Expression "first"), Located 4 (Expression "second")])
where
dataKindsError = ParseError (Loc 1 10) msg
#if MIN_VERSION_ghc(7, 10, 0)
msg = "Cannot parse data constructor in a data/newtype declaration: 3"
#elif MIN_VERSION_ghc(7, 8, 0)
msg = "Illegal literal in type (use DataKinds to enable): 3"
#else
msg = "Illegal literal in type (use -XDataKinds to enable): 3"
#endif