mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-16 19:36:06 +00:00
Drop support for GHC < 8.0
This commit is contained in:
parent
6919aa67d4
commit
18e108811f
@ -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, (!!),
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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, (!!),
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user