Commit 46aed8a4 authored by Ian Lynagh's avatar Ian Lynagh

Use haskeline, rather than editline, for line editing in ghci

parent e213baf0
...@@ -943,20 +943,6 @@ else ...@@ -943,20 +943,6 @@ else
fi])# FP_PROG_GHC_PKG fi])# FP_PROG_GHC_PKG
# FP_GHC_HAS_EDITLINE
# -------------------
AC_DEFUN([FP_GHC_HAS_EDITLINE],
[AC_REQUIRE([FP_PROG_GHC_PKG])
AC_CACHE_CHECK([whether ghc has editline package], [fp_cv_ghc_has_editline],
[if "${GhcPkgCmd-ghc-pkg}" --show-package editline >/dev/null 2>&1; then
fp_cv_ghc_has_editline=yes
else
fp_cv_ghc_has_editline=no
fi])
AC_SUBST([GhcHasEditline], [`echo $fp_cv_ghc_has_editline | sed 'y/yesno/YESNO/'`])
])# FP_GHC_HAS_EDITLINE
# FP_GCC_EXTRA_FLAGS # FP_GCC_EXTRA_FLAGS
# ------------------ # ------------------
# Determine which extra flags we need to pass gcc when we invoke it # Determine which extra flags we need to pass gcc when we invoke it
......
...@@ -31,11 +31,6 @@ Flag dynlibs ...@@ -31,11 +31,6 @@ Flag dynlibs
Default: False Default: False
Manual: True Manual: True
Flag editline
Description: Use editline
Default: False
Manual: True
Flag ghci Flag ghci
Description: Build GHCi support. Description: Build GHCi support.
Default: False Default: False
...@@ -83,10 +78,6 @@ Library ...@@ -83,10 +78,6 @@ Library
else else
Build-Depends: unix Build-Depends: unix
if flag(editline)
Build-Depends: editline
CPP-Options: -DUSE_EDITLINE
GHC-Options: -Wall -fno-warn-name-shadowing -fno-warn-orphans GHC-Options: -Wall -fno-warn-name-shadowing -fno-warn-orphans
if flag(ghci) if flag(ghci)
...@@ -547,9 +538,6 @@ Library ...@@ -547,9 +538,6 @@ Library
ByteCodeItbls ByteCodeItbls
ByteCodeLink ByteCodeLink
Debugger Debugger
GhciMonad
GhciTags
InteractiveUI
LibFFI LibFFI
Linker Linker
ObjLink ObjLink
......
...@@ -708,25 +708,6 @@ if test "$WithGhc" != ""; then ...@@ -708,25 +708,6 @@ if test "$WithGhc" != ""; then
AC_SUBST(ghc_ge_609)dnl AC_SUBST(ghc_ge_609)dnl
fi fi
# Check whether this GHC has editline installed
FP_GHC_HAS_EDITLINE
# Dummy arguments to print help for --with-editline-* arguments.
# Those are actually passed to the editline package's configure script
# via the CONFIGURE_ARGS variable in mk/config.mk
AC_ARG_WITH(dummy-editline-includes,
[AC_HELP_STRING([--with-editline-includes],
[directory containing editline/editline.h or editline/readline.h])],
[],
[])
AC_ARG_WITH(dummy-editline-libraries,
[AC_HELP_STRING([--with-editline-libraries],
[directory containing the editline library])],
[],
[])
AC_PATH_PROGS(NHC,nhc nhc98) AC_PATH_PROGS(NHC,nhc nhc98)
AC_PATH_PROG(HBC,hbc) AC_PATH_PROG(HBC,hbc)
......
...@@ -308,7 +308,15 @@ PACKAGES += \ ...@@ -308,7 +308,15 @@ PACKAGES += \
syb \ syb \
template-haskell \ template-haskell \
base3-compat \ base3-compat \
Cabal Cabal \
mtl \
utf8-string
ifneq "$(Windows)" "YES"
PACKAGES += terminfo
endif
PACKAGES += haskeline
BOOT_PKGS = Cabal hpc extensible-exceptions BOOT_PKGS = Cabal hpc extensible-exceptions
......
{-# OPTIONS -fno-cse #-} {-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly -- -fno-cse is needed for GLOBAL_VAR's to behave properly
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
...@@ -15,17 +15,19 @@ module GhciMonad where ...@@ -15,17 +15,19 @@ module GhciMonad where
import qualified GHC import qualified GHC
import Outputable hiding (printForUser, printForUserPartWay) import Outputable hiding (printForUser, printForUserPartWay)
import qualified Pretty
import qualified Outputable import qualified Outputable
import Panic hiding (showException) import Panic hiding (showException)
import Util import Util
import DynFlags import DynFlags
import HscTypes import HscTypes hiding (liftIO)
import SrcLoc import SrcLoc
import Module import Module
import ObjLink import ObjLink
import Linker import Linker
import StaticFlags import StaticFlags
import MonadUtils ( MonadIO, liftIO ) import qualified MonadUtils
import qualified ErrUtils
import Exception import Exception
import Data.Maybe import Data.Maybe
...@@ -41,10 +43,16 @@ import System.IO ...@@ -41,10 +43,16 @@ import System.IO
import Control.Monad as Monad import Control.Monad as Monad
import GHC.Exts import GHC.Exts
import System.Console.Haskeline (CompletionFunc, InputT)
import qualified System.Console.Haskeline as Haskeline
import System.Console.Haskeline.Encoding
import Control.Monad.Trans as Trans
import qualified Data.ByteString as B
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- GHCi monad -- GHCi monad
type Command = (String, String -> GHCi Bool, Maybe String, String -> IO [String]) type Command = (String, String -> InputT GHCi Bool, CompletionFunc GHCi)
data GHCiState = GHCiState data GHCiState = GHCiState
{ {
...@@ -159,13 +167,27 @@ setGHCiState s = GHCi $ \r -> liftIO $ writeIORef r s ...@@ -159,13 +167,27 @@ setGHCiState s = GHCi $ \r -> liftIO $ writeIORef r s
liftGhc :: Ghc a -> GHCi a liftGhc :: Ghc a -> GHCi a
liftGhc m = GHCi $ \_ -> m liftGhc m = GHCi $ \_ -> m
instance MonadIO GHCi where instance MonadUtils.MonadIO GHCi where
liftIO m = liftGhc $ liftIO m liftIO = liftGhc . MonadUtils.liftIO
instance Trans.MonadIO Ghc where
liftIO = MonadUtils.liftIO
instance GhcMonad GHCi where instance GhcMonad GHCi where
setSession s' = liftGhc $ setSession s' setSession s' = liftGhc $ setSession s'
getSession = liftGhc $ getSession getSession = liftGhc $ getSession
instance GhcMonad (InputT GHCi) where
setSession = lift . setSession
getSession = lift getSession
instance MonadUtils.MonadIO (InputT GHCi) where
liftIO = Trans.liftIO
instance WarnLogMonad (InputT GHCi) where
setWarnings = lift . setWarnings
getWarnings = lift getWarnings
instance ExceptionMonad GHCi where instance ExceptionMonad GHCi where
gcatch m h = GHCi $ \r -> unGHCi m r `gcatch` (\e -> unGHCi (h e) r) gcatch m h = GHCi $ \r -> unGHCi m r `gcatch` (\e -> unGHCi (h e) r)
gblock (GHCi m) = GHCi $ \r -> gblock (m r) gblock (GHCi m) = GHCi $ \r -> gblock (m r)
...@@ -175,33 +197,24 @@ instance WarnLogMonad GHCi where ...@@ -175,33 +197,24 @@ instance WarnLogMonad GHCi where
setWarnings warns = liftGhc $ setWarnings warns setWarnings warns = liftGhc $ setWarnings warns
getWarnings = liftGhc $ getWarnings getWarnings = liftGhc $ getWarnings
-- for convenience... instance MonadIO GHCi where
getPrelude :: GHCi Module liftIO = io
getPrelude = getGHCiState >>= return . prelude
GLOBAL_VAR(saved_sess, no_saved_sess, Session)
no_saved_sess :: Session
no_saved_sess = error "no saved_ses"
saveSession :: GHCi ()
saveSession =
liftGhc $ do
reifyGhc $ \s ->
writeIORef saved_sess s
splatSavedSession :: GHCi () instance Haskeline.MonadException GHCi where
splatSavedSession = io (writeIORef saved_sess no_saved_sess) catch = gcatch
block = gblock
unblock = gunblock
-- restoreSession :: IO Session instance ExceptionMonad (InputT GHCi) where
-- restoreSession = readIORef saved_sess gcatch = Haskeline.catch
gblock = Haskeline.block
gunblock = Haskeline.unblock
withRestoredSession :: Ghc a -> IO a -- for convenience...
withRestoredSession ghc = do getPrelude :: GHCi Module
s <- readIORef saved_sess getPrelude = getGHCiState >>= return . prelude
reflectGhc ghc s
getDynFlags :: GHCi DynFlags getDynFlags :: GhcMonad m => m DynFlags
getDynFlags = do getDynFlags = do
GHC.getSessionDynFlags GHC.getSessionDynFlags
...@@ -225,18 +238,44 @@ unsetOption opt ...@@ -225,18 +238,44 @@ unsetOption opt
setGHCiState (st{ options = filter (/= opt) (options st) }) setGHCiState (st{ options = filter (/= opt) (options st) })
io :: IO a -> GHCi a io :: IO a -> GHCi a
io = liftIO io = MonadUtils.liftIO
printForUser :: SDoc -> GHCi () printForUser :: SDoc -> GHCi ()
printForUser doc = do printForUser doc = do
unqual <- GHC.getPrintUnqual unqual <- GHC.getPrintUnqual
io $ Outputable.printForUser stdout unqual doc io $ Outputable.printForUser stdout unqual doc
printForUser' :: SDoc -> InputT GHCi ()
printForUser' doc = do
unqual <- GHC.getPrintUnqual
Haskeline.outputStrLn $ showSDocForUser unqual doc
printForUserPartWay :: SDoc -> GHCi () printForUserPartWay :: SDoc -> GHCi ()
printForUserPartWay doc = do printForUserPartWay doc = do
unqual <- GHC.getPrintUnqual unqual <- GHC.getPrintUnqual
io $ Outputable.printForUserPartWay stdout opt_PprUserLength unqual doc io $ Outputable.printForUserPartWay stdout opt_PprUserLength unqual doc
-- We set log_action to write encoded output.
-- This fails whenever GHC tries to mention an (already encoded) filename,
-- but I don't know how to work around that.
setLogAction :: InputT GHCi ()
setLogAction = do
encoder <- getEncoder
dflags <- GHC.getSessionDynFlags
GHC.setSessionDynFlags dflags {log_action = logAction encoder}
return ()
where
logAction encoder severity srcSpan style msg = case severity of
GHC.SevInfo -> printEncErrs encoder (msg style)
GHC.SevFatal -> printEncErrs encoder (msg style)
_ -> do
hPutChar stderr '\n'
printEncErrs encoder (ErrUtils.mkLocMessage srcSpan msg style)
printEncErrs encoder doc = do
str <- encoder (Pretty.showDocWith Pretty.PageMode doc)
B.hPutStrLn stderr str
hFlush stderr
runStmt :: String -> GHC.SingleStep -> GHCi GHC.RunResult runStmt :: String -> GHC.SingleStep -> GHCi GHC.RunResult
runStmt expr step = do runStmt expr step = do
st <- getGHCiState st <- getGHCiState
...@@ -254,17 +293,17 @@ resume canLogSpan step = GHC.resume canLogSpan step ...@@ -254,17 +293,17 @@ resume canLogSpan step = GHC.resume canLogSpan step
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- timing & statistics -- timing & statistics
timeIt :: GHCi a -> GHCi a timeIt :: InputT GHCi a -> InputT GHCi a
timeIt action timeIt action
= do b <- isOptionSet ShowTiming = do b <- lift $ isOptionSet ShowTiming
if not b if not b
then action then action
else do allocs1 <- io $ getAllocations else do allocs1 <- liftIO $ getAllocations
time1 <- io $ getCPUTime time1 <- liftIO $ getCPUTime
a <- action a <- action
allocs2 <- io $ getAllocations allocs2 <- liftIO $ getAllocations
time2 <- io $ getCPUTime time2 <- liftIO $ getCPUTime
io $ printTimes (fromIntegral (allocs2 - allocs1)) liftIO $ printTimes (fromIntegral (allocs2 - allocs1))
(time2 - time1) (time2 - time1)
return a return a
......
...@@ -28,15 +28,29 @@ Executable ghc ...@@ -28,15 +28,29 @@ Executable ghc
Main-Is: Main.hs Main-Is: Main.hs
if flag(base3) if flag(base3)
Build-Depends: base >= 3 && < 5, Build-Depends: base >= 3 && < 5,
directory >= 1 && < 1.1 array >= 0.1 && < 0.3,
bytestring >= 0.9 && < 0.10,
directory >= 1 && < 1.1,
process >= 1 && < 1.1
else else
Build-Depends: base < 3 Build-Depends: base < 3
Build-Depends: base, ghc Build-Depends: base, ghc
Build-Depends: filepath >= 1 && < 1.2 Build-Depends: filepath >= 1 && < 1.2
if os(windows)
Build-Depends: Win32
else
Build-Depends: unix
GHC-Options: -Wall GHC-Options: -Wall
if flag(ghci) if flag(ghci)
CPP-Options: -DGHCI CPP-Options: -DGHCI
GHC-Options: -fno-warn-name-shadowing
Other-Modules: InteractiveUI, GhciMonad, GhciTags
Build-Depends: mtl, haskeline
Extensions: ForeignFunctionInterface,
UnboxedTuples,
FlexibleInstances,
MagicHash
Extensions: CPP, PatternGuards Extensions: CPP, PatternGuards
...@@ -41,8 +41,8 @@ endif ...@@ -41,8 +41,8 @@ endif
ghc_stage1_MODULES = Main ghc_stage1_MODULES = Main
ghc_stage2_MODULES = $(ghc_stage1_MODULES) ghc_stage2_MODULES = $(ghc_stage1_MODULES) GhciMonad GhciTags InteractiveUI
ghc_stage3_MODULES = $(ghc_stage1_MODULES) ghc_stage3_MODULES = $(ghc_stage2_MODULES)
ghc_stage1_PROG = ghc-stage1$(exeext) ghc_stage1_PROG = ghc-stage1$(exeext)
ghc_stage2_PROG = ghc-stage2$(exeext) ghc_stage2_PROG = ghc-stage2$(exeext)
...@@ -53,10 +53,18 @@ ghc_stage1_USE_BOOT_LIBS = YES ...@@ -53,10 +53,18 @@ ghc_stage1_USE_BOOT_LIBS = YES
ghc_stage1_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage1_VERSION) ghc_stage1_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage1_VERSION)
ghc_stage2_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage2_VERSION) ghc_stage2_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage2_VERSION)
ghc_stage3_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage3_VERSION) ghc_stage3_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage3_VERSION)
ghc_stage2_HC_OPTS += -package haskeline
ghc_stage1_HC_OPTS += -XCPP -XPatternGuards ghc_stage3_HC_OPTS += -package haskeline
ghc_stage2_HC_OPTS += -XCPP -XPatternGuards
ghc_stage3_HC_OPTS += -XCPP -XPatternGuards ghc_language_extension_flags = -XCPP \
-XPatternGuards \
-XForeignFunctionInterface \
-XUnboxedTuples \
-XFlexibleInstances \
-XMagicHash
ghc_stage1_HC_OPTS += $(ghc_language_extension_flags)
ghc_stage2_HC_OPTS += $(ghc_language_extension_flags)
ghc_stage3_HC_OPTS += $(ghc_language_extension_flags)
# In stage1 we might not benefit from cross-package dependencies and # In stage1 we might not benefit from cross-package dependencies and
# recompilation checking. We must force recompilation here, otherwise # recompilation checking. We must force recompilation here, otherwise
......
...@@ -26,13 +26,14 @@ libraries/bytestring packages/bytestring darcs ...@@ -26,13 +26,14 @@ libraries/bytestring packages/bytestring darcs
libraries/Cabal packages/Cabal darcs libraries/Cabal packages/Cabal darcs
libraries/containers packages/containers darcs libraries/containers packages/containers darcs
libraries/directory packages/directory darcs libraries/directory packages/directory darcs
libraries/editline packages/editline darcs
libraries/extensible-exceptions packages/extensible-exceptions darcs libraries/extensible-exceptions packages/extensible-exceptions darcs
libraries/filepath packages/filepath darcs libraries/filepath packages/filepath darcs
libraries/ghc-prim packages/ghc-prim darcs libraries/ghc-prim packages/ghc-prim darcs
libraries/haskeline packages/haskeline darcs
libraries/haskell98 packages/haskell98 darcs libraries/haskell98 packages/haskell98 darcs
libraries/hpc packages/hpc darcs libraries/hpc packages/hpc darcs
libraries/integer-gmp packages/integer-gmp darcs libraries/integer-gmp packages/integer-gmp darcs
libraries/mtl packages/mtl darcs
libraries/old-locale packages/old-locale darcs libraries/old-locale packages/old-locale darcs
libraries/old-time packages/old-time darcs libraries/old-time packages/old-time darcs
libraries/packedstring packages/packedstring darcs libraries/packedstring packages/packedstring darcs
...@@ -41,13 +42,14 @@ libraries/process packages/process darcs ...@@ -41,13 +42,14 @@ libraries/process packages/process darcs
libraries/random packages/random darcs libraries/random packages/random darcs
libraries/syb packages/syb darcs libraries/syb packages/syb darcs
libraries/template-haskell packages/template-haskell darcs libraries/template-haskell packages/template-haskell darcs
libraries/terminfo packages/terminfo darcs
libraries/unix packages/unix darcs libraries/unix packages/unix darcs
libraries/utf8-string packages/utf8-string darcs
libraries/Win32 packages/Win32 darcs libraries/Win32 packages/Win32 darcs
libraries/HUnit extralibs packages/HUnit darcs libraries/HUnit extralibs packages/HUnit darcs
libraries/QuickCheck extralibs packages/QuickCheck darcs libraries/QuickCheck extralibs packages/QuickCheck darcs
libraries/haskell-src extralibs packages/haskell-src darcs libraries/haskell-src extralibs packages/haskell-src darcs
libraries/html extralibs packages/html darcs libraries/html extralibs packages/html darcs
libraries/mtl extralibs packages/mtl darcs
libraries/network extralibs packages/network darcs libraries/network extralibs packages/network darcs
libraries/parsec extralibs packages/parsec darcs libraries/parsec extralibs packages/parsec darcs
libraries/parallel extralibs packages/parallel darcs libraries/parallel extralibs packages/parallel darcs
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment