Skip to content

GitLab

Commit 46aed8a4 authored by Ian Lynagh's avatar Ian Lynagh
Browse files
Options

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

parent e213baf0
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 383 additions and 516 deletions
aclocal.m4
View file @ 46aed8a4
......@@ -943,20 +943,6 @@ else
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
# ------------------
# Determine which extra flags we need to pass gcc when we invoke it
......
compiler/ghc.cabal.in
View file @ 46aed8a4
......@@ -31,11 +31,6 @@ Flag dynlibs
Default: False
Manual: True
Flag editline
Description: Use editline
Default: False
Manual: True
Flag ghci
Description: Build GHCi support.
Default: False
......@@ -83,10 +78,6 @@ Library
else
Build-Depends: unix
if flag(editline)
Build-Depends: editline
CPP-Options: -DUSE_EDITLINE
GHC-Options: -Wall -fno-warn-name-shadowing -fno-warn-orphans
if flag(ghci)
......@@ -547,9 +538,6 @@ Library
ByteCodeItbls
ByteCodeLink
Debugger
GhciMonad
GhciTags
InteractiveUI
LibFFI
Linker
ObjLink
......
configure.ac
View file @ 46aed8a4
......@@ -708,25 +708,6 @@ if test "$WithGhc" != ""; then
AC_SUBST(ghc_ge_609)dnl
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_PROG(HBC,hbc)
......
ghc.mk
View file @ 46aed8a4
......@@ -308,7 +308,15 @@ PACKAGES += \
syb \
template-haskell \
base3-compat \
Cabal
Cabal \
mtl \
utf8-string
ifneq "$(Windows)" "YES"
PACKAGES += terminfo
endif
PACKAGES += haskeline
BOOT_PKGS = Cabal hpc extensible-exceptions
......
compiler/ghci/GhciMonad.hs → ghc/GhciMonad.hs
View file @ 46aed8a4
{-# OPTIONS -fno-cse #-}
{-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
-----------------------------------------------------------------------------
......@@ -15,17 +15,19 @@ module GhciMonad where
import qualified GHC
import Outputable hiding (printForUser, printForUserPartWay)
import qualified Pretty
import qualified Outputable
import Panic hiding (showException)
import Util
import DynFlags
import HscTypes
import HscTypes hiding (liftIO)
import SrcLoc
import Module
import ObjLink
import Linker
import StaticFlags
import MonadUtils ( MonadIO, liftIO )
import qualified MonadUtils
import qualified ErrUtils
import Exception
import Data.Maybe
......@@ -41,10 +43,16 @@ import System.IO
import Control.Monad as Monad
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
type Command = (String, String -> GHCi Bool, Maybe String, String -> IO [String])
type Command = (String, String -> InputT GHCi Bool, CompletionFunc GHCi)
data GHCiState = GHCiState
{
......@@ -159,13 +167,27 @@ setGHCiState s = GHCi $ \r -> liftIO $ writeIORef r s
liftGhc :: Ghc a -> GHCi a
liftGhc m = GHCi $ \_ -> m
instance MonadIO GHCi where
liftIO m = liftGhc $ liftIO m
instance MonadUtils.MonadIO GHCi where
liftIO = liftGhc . MonadUtils.liftIO
instance Trans.MonadIO Ghc where
liftIO = MonadUtils.liftIO
instance GhcMonad GHCi where
setSession s' = liftGhc $ setSession s'
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
gcatch m h = GHCi $ \r -> unGHCi m r `gcatch` (\e -> unGHCi (h e) r)
gblock (GHCi m) = GHCi $ \r -> gblock (m r)
......@@ -175,33 +197,24 @@ instance WarnLogMonad GHCi where
setWarnings warns = liftGhc $ setWarnings warns
getWarnings = liftGhc $ getWarnings
-- for convenience...
getPrelude :: GHCi Module
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
instance MonadIO GHCi where
liftIO = io
splatSavedSession :: GHCi ()
splatSavedSession = io (writeIORef saved_sess no_saved_sess)
instance Haskeline.MonadException GHCi where
catch = gcatch
block = gblock
unblock = gunblock
-- restoreSession :: IO Session
-- restoreSession = readIORef saved_sess
instance ExceptionMonad (InputT GHCi) where
gcatch = Haskeline.catch
gblock = Haskeline.block
gunblock = Haskeline.unblock
withRestoredSession :: Ghc a -> IO a
withRestoredSession ghc = do
s <- readIORef saved_sess
reflectGhc ghc s
-- for convenience...
getPrelude :: GHCi Module
getPrelude = getGHCiState >>= return . prelude
getDynFlags :: GHCi DynFlags
getDynFlags :: GhcMonad m => m DynFlags
getDynFlags = do
GHC.getSessionDynFlags
......@@ -225,18 +238,44 @@ unsetOption opt
setGHCiState (st{ options = filter (/= opt) (options st) })
io :: IO a -> GHCi a
io = liftIO
io = MonadUtils.liftIO
printForUser :: SDoc -> GHCi ()
printForUser doc = do
unqual <- GHC.getPrintUnqual
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 doc = do
unqual <- GHC.getPrintUnqual
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 expr step = do
st <- getGHCiState
......@@ -254,17 +293,17 @@ resume canLogSpan step = GHC.resume canLogSpan step
-- --------------------------------------------------------------------------
-- timing & statistics
timeIt :: GHCi a -> GHCi a
timeIt :: InputT GHCi a -> InputT GHCi a
timeIt action
= do b <- isOptionSet ShowTiming
= do b <- lift $ isOptionSet ShowTiming
if not b
then action
else do allocs1 <- io $ getAllocations
time1 <- io $ getCPUTime
else do allocs1 <- liftIO $ getAllocations
time1 <- liftIO $ getCPUTime
a <- action
allocs2 <- io $ getAllocations
time2 <- io $ getCPUTime
io $ printTimes (fromIntegral (allocs2 - allocs1))
allocs2 <- liftIO $ getAllocations
time2 <- liftIO $ getCPUTime
liftIO $ printTimes (fromIntegral (allocs2 - allocs1))
(time2 - time1)
return a
......
ghc/ghc-bin.cabal.in
View file @ 46aed8a4
......@@ -28,15 +28,29 @@ Executable ghc
Main-Is: Main.hs
if flag(base3)
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
Build-Depends: base < 3
Build-Depends: base, ghc
Build-Depends: filepath >= 1 && < 1.2
if os(windows)
Build-Depends: Win32
else
Build-Depends: unix
GHC-Options: -Wall
if flag(ghci)
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
ghc/ghc.mk
View file @ 46aed8a4
......@@ -41,8 +41,8 @@ endif
ghc_stage1_MODULES = Main
ghc_stage2_MODULES = $(ghc_stage1_MODULES)
ghc_stage3_MODULES = $(ghc_stage1_MODULES)
ghc_stage2_MODULES = $(ghc_stage1_MODULES) GhciMonad GhciTags InteractiveUI
ghc_stage3_MODULES = $(ghc_stage2_MODULES)
ghc_stage1_PROG = ghc-stage1$(exeext)
ghc_stage2_PROG = ghc-stage2$(exeext)
......@@ -53,10 +53,18 @@ ghc_stage1_USE_BOOT_LIBS = YES
ghc_stage1_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage1_VERSION)
ghc_stage2_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage2_VERSION)
ghc_stage3_HC_OPTS += -package $(compiler_PACKAGE)-$(compiler_stage3_VERSION)
ghc_stage1_HC_OPTS += -XCPP -XPatternGuards
ghc_stage2_HC_OPTS += -XCPP -XPatternGuards
ghc_stage3_HC_OPTS += -XCPP -XPatternGuards
ghc_stage2_HC_OPTS += -package haskeline
ghc_stage3_HC_OPTS += -package haskeline
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
# recompilation checking. We must force recompilation here, otherwise
......
packages
View file @ 46aed8a4
......@@ -26,13 +26,14 @@ libraries/bytestring packages/bytestring darcs
libraries/Cabal packages/Cabal darcs
libraries/containers packages/containers darcs
libraries/directory packages/directory darcs
libraries/editline packages/editline darcs
libraries/extensible-exceptions packages/extensible-exceptions darcs
libraries/filepath packages/filepath darcs
libraries/ghc-prim packages/ghc-prim darcs
libraries/haskeline packages/haskeline darcs
libraries/haskell98 packages/haskell98 darcs
libraries/hpc packages/hpc darcs
libraries/integer-gmp packages/integer-gmp darcs
libraries/mtl packages/mtl darcs
libraries/old-locale packages/old-locale darcs
libraries/old-time packages/old-time darcs
libraries/packedstring packages/packedstring darcs
......@@ -41,13 +42,14 @@ libraries/process packages/process darcs
libraries/random packages/random darcs
libraries/syb packages/syb darcs
libraries/template-haskell packages/template-haskell darcs
libraries/terminfo packages/terminfo darcs
libraries/unix packages/unix darcs
libraries/utf8-string packages/utf8-string darcs
libraries/Win32 packages/Win32 darcs
libraries/HUnit extralibs packages/HUnit darcs
libraries/QuickCheck extralibs packages/QuickCheck darcs
libraries/haskell-src extralibs packages/haskell-src darcs
libraries/html extralibs packages/html darcs
libraries/mtl extralibs packages/mtl darcs
libraries/network extralibs packages/network darcs
libraries/parsec extralibs packages/parsec 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