Commit 315a1f6c authored by Simon Marlow's avatar Simon Marlow
Browse files

Basic completion in GHCi

This patch adds completion support to GHCi when readline is being
used.  Completion of identifiers (in scope only, but including
qualified identifiers) in expressions is provided.  Also, completion
of commands (:cmd), and special completion for certain commands
(eg. module names for the :module command) are also provided.
parent 594aa496
......@@ -16,11 +16,14 @@ module InteractiveUI (
-- The GHC interface
import qualified GHC
import GHC ( Session, verbosity, dopt, DynFlag(..), Target(..),
TargetId(..),
mkModule, pprModule, Type, Module, SuccessFlag(..),
TargetId(..), DynFlags(..),
pprModule, Type, Module, SuccessFlag(..),
TyThing(..), Name, LoadHowMuch(..), Phase,
GhcException(..), showGhcException,
CheckedModule(..), SrcLoc )
import Packages ( PackageState(..) )
import PackageConfig ( InstalledPackageInfo(..) )
import UniqFM ( eltsUFM )
import PprTyThing
import Outputable
......@@ -74,6 +77,7 @@ import System.IO.Error as IO
import Data.Char
import Control.Monad as Monad
import Foreign.StablePtr ( newStablePtr )
import Text.Printf
import GHC.Exts ( unsafeCoerce# )
import GHC.IOBase ( IOErrorType(InvalidArgument) )
......@@ -91,31 +95,34 @@ ghciWelcomeMsg =
"/ /_\\\\/ __ / /___| | http://www.haskell.org/ghc/\n"++
"\\____/\\/ /_/\\____/|_| Type :? for help.\n"
GLOBAL_VAR(commands, builtin_commands, [(String, String -> GHCi Bool)])
type Command = (String, String -> GHCi Bool, String -> IO [String])
cmdName (n,_,_) = n
builtin_commands :: [(String, String -> GHCi Bool)]
GLOBAL_VAR(commands, builtin_commands, [Command])
builtin_commands :: [Command]
builtin_commands = [
("add", keepGoingPaths addModule),
("browse", keepGoing browseCmd),
("cd", keepGoing changeDirectory),
("def", keepGoing defineMacro),
("help", keepGoing help),
("?", keepGoing help),
("info", keepGoing info),
("load", keepGoingPaths loadModule_),
("module", keepGoing setContext),
("main", keepGoing runMain),
("reload", keepGoing reloadModule),
("check", keepGoing checkModule),
("set", keepGoing setCmd),
("show", keepGoing showCmd),
("etags", keepGoing createETagsFileCmd),
("ctags", keepGoing createCTagsFileCmd),
("type", keepGoing typeOfExpr),
("kind", keepGoing kindOfType),
("unset", keepGoing unsetOptions),
("undef", keepGoing undefineMacro),
("quit", quit)
("add", keepGoingPaths addModule, completeFilename),
("browse", keepGoing browseCmd, completeModule),
("cd", keepGoing changeDirectory, completeFilename),
("def", keepGoing defineMacro, completeIdentifier),
("help", keepGoing help, completeNone),
("?", keepGoing help, completeNone),
("info", keepGoing info, completeIdentifier),
("load", keepGoingPaths loadModule_, completeHomeModuleOrFile),
("module", keepGoing setContext, completeModule),
("main", keepGoing runMain, completeIdentifier),
("reload", keepGoing reloadModule, completeNone),
("check", keepGoing checkModule, completeHomeModule),
("set", keepGoing setCmd, completeNone), -- ToDo
("show", keepGoing showCmd, completeNone),
("etags", keepGoing createETagsFileCmd, completeFilename),
("ctags", keepGoing createCTagsFileCmd, completeFilename),
("type", keepGoing typeOfExpr, completeIdentifier),
("kind", keepGoing kindOfType, completeIdentifier),
("unset", keepGoing unsetOptions, completeNone), -- ToDo
("undef", keepGoing undefineMacro, completeNone), -- ToDo
("quit", quit, completeNone)
]
keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
......@@ -197,6 +204,16 @@ interactiveUI session srcs maybe_expr = do
#ifdef USE_READLINE
Readline.initialize
Readline.setAttemptedCompletionFunction (Just completeWord)
--Readline.parseAndBind "set show-all-if-ambiguous 1"
let symbols = "!#$%&*+/<=>?@\\^|-~"
specials = "(),;[]`{}"
spaces = " \t\n"
word_break_chars = spaces ++ specials ++ symbols
Readline.setBasicWordBreakCharacters word_break_chars
Readline.setCompleterWordBreakCharacters word_break_chars
#endif
startGHCi (runGHCi srcs maybe_expr)
......@@ -378,10 +395,12 @@ readlineLoop = do
session <- getSession
(mod,imports) <- io (GHC.getContext session)
io yield
saveSession -- for use by completion
l <- io (readline (mkPrompt mod imports)
`finally` setNonBlockingFD 0)
-- readline sometimes puts stdin into blocking mode,
-- so we need to put it back for the IO library
splatSavedSession
case l of
Nothing -> return ()
Just l ->
......@@ -488,14 +507,21 @@ specialCommand :: String -> GHCi Bool
specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
specialCommand str = do
let (cmd,rest) = break isSpace str
cmds <- io (readIORef commands)
-- look for exact match first, then the first prefix match
case [ (s,f) | (s,f) <- cmds, cmd == s ] of
(_,f):_ -> f (dropWhile isSpace rest)
[] -> case [ (s,f) | (s,f) <- cmds, prefixMatch cmd s ] of
[] -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
maybe_cmd <- io (lookupCommand cmd)
case maybe_cmd of
Nothing -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
++ shortHelpText) >> return False)
(_,f):_ -> f (dropWhile isSpace rest)
Just (_,f,_) -> f (dropWhile isSpace rest)
lookupCommand :: String -> IO (Maybe Command)
lookupCommand str = do
cmds <- readIORef commands
-- look for exact match first, then the first prefix match
case [ c | c <- cmds, str == cmdName c ] of
c:_ -> return (Just c)
[] -> case [ c | c@(s,_,_) <- cmds, prefixMatch str s ] of
[] -> return Nothing
c:_ -> return (Just c)
-----------------------------------------------------------------------------
-- To flush buffers for the *interpreted* computation we need
......@@ -616,7 +642,7 @@ defineMacro s = do
if (null macro_name)
then throwDyn (CmdLineError "invalid macro name")
else do
if (macro_name `elem` map fst cmds)
if (macro_name `elem` map cmdName cmds)
then throwDyn (CmdLineError
("command '" ++ macro_name ++ "' is already defined"))
else do
......@@ -631,7 +657,7 @@ defineMacro s = do
case maybe_hv of
Nothing -> return ()
Just hv -> io (writeIORef commands --
(cmds ++ [(macro_name, keepGoing (runMacro hv))]))
(cmds ++ [(macro_name, keepGoing (runMacro hv), completeNone)]))
runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi ()
runMacro fun s = do
......@@ -641,15 +667,15 @@ runMacro fun s = do
undefineMacro :: String -> GHCi ()
undefineMacro macro_name = do
cmds <- io (readIORef commands)
if (macro_name `elem` map fst builtin_commands)
if (macro_name `elem` map cmdName builtin_commands)
then throwDyn (CmdLineError
("command '" ++ macro_name ++ "' cannot be undefined"))
else do
if (macro_name `notElem` map fst cmds)
if (macro_name `notElem` map cmdName cmds)
then throwDyn (CmdLineError
("command '" ++ macro_name ++ "' not defined"))
else do
io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
......@@ -684,7 +710,7 @@ loadModule' files = do
checkModule :: String -> GHCi ()
checkModule m = do
let modl = mkModule m
let modl = GHC.mkModule m
session <- getSession
result <- io (GHC.checkModule session modl)
case result of
......@@ -709,7 +735,7 @@ reloadModule "" = do
reloadModule m = do
io (revertCAFs) -- always revert CAFs on reload.
session <- getSession
ok <- io (GHC.load session (LoadUpTo (mkModule m)))
ok <- io (GHC.load session (LoadUpTo (GHC.mkModule m)))
afterLoad ok session
afterLoad ok session = do
......@@ -913,7 +939,7 @@ browseCmd m =
browseModule m exports_only = do
s <- getSession
let modl = mkModule m
let modl = GHC.mkModule m
is_interpreted <- io (GHC.moduleIsInterpreted s modl)
when (not is_interpreted && not exports_only) $
throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
......@@ -972,13 +998,13 @@ separate :: Session -> [String] -> [Module] -> [Module]
-> GHCi ([Module],[Module])
separate session [] as bs = return (as,bs)
separate session (('*':m):ms) as bs = do
let modl = mkModule m
let modl = GHC.mkModule m
b <- io (GHC.moduleIsInterpreted session modl)
if b then separate session ms (modl:as) bs
else throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
separate session (m:ms) as bs = separate session ms as (mkModule m:bs)
separate session (m:ms) as bs = separate session ms as (GHC.mkModule m:bs)
prelude_mod = mkModule "Prelude"
prelude_mod = GHC.mkModule "Prelude"
addToContext mods = do
......@@ -1156,6 +1182,88 @@ cleanType ty = do
then return ty
else return $! GHC.dropForAlls ty
-- -----------------------------------------------------------------------------
-- Completion
#ifdef USE_READLINE
completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
completeWord w start end = do
line <- Readline.getLineBuffer
case w of
':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
_other
| Just c <- is_cmd line -> do
maybe_cmd <- lookupCommand c
case maybe_cmd of
Nothing -> return Nothing
Just (_,_,complete) -> wrapCompleter complete w
| otherwise -> do
--printf "complete %s, start = %d, end = %d\n" w start end
wrapCompleter completeIdentifier w
is_cmd line
| ((':':w) : _) <- words (dropWhile isSpace line) = Just w
| otherwise = Nothing
completeNone w = return []
completeCmd w = do
cmds <- readIORef commands
return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds)))
completeIdentifier w = do
s <- restoreSession
rdrs <- GHC.getRdrNamesInScope s
return (filter (w `isPrefixOf`) (map (showSDoc.ppr) rdrs))
completeModule w = do
s <- restoreSession
dflags <- GHC.getSessionDynFlags s
let pkg_mods = allExposedModules dflags
return (filter (w `isPrefixOf`) (map (showSDoc.ppr) pkg_mods))
completeHomeModule w = do
s <- restoreSession
g <- GHC.getModuleGraph s
let home_mods = map GHC.ms_mod g
return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
completeFilename = Readline.filenameCompletionFunction
completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
unionComplete :: (String -> IO [String]) -> (String -> IO [String]) -> String -> IO [String]
unionComplete f1 f2 w = do
s1 <- f1 w
s2 <- f2 w
return (s1 ++ s2)
wrapCompleter :: (String -> IO [String]) -> String -> IO (Maybe (String,[String]))
wrapCompleter fun w = do
strs <- fun w
case strs of
[] -> return Nothing
[x] -> return (Just (x,[]))
xs -> case getCommonPrefix xs of
"" -> return (Just ("",xs))
pref -> return (Just (pref,xs))
getCommonPrefix :: [String] -> String
getCommonPrefix [] = ""
getCommonPrefix (s:ss) = foldl common s ss
where common s "" = s
common "" s = ""
common (c:cs) (d:ds)
| c == d = c : common cs ds
| otherwise = ""
allExposedModules :: DynFlags -> [Module]
allExposedModules dflags
= map GHC.mkModule (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
where
pkg_db = pkgIdMap (pkgState dflags)
#endif
-----------------------------------------------------------------------------
-- GHCi monad
......@@ -1192,6 +1300,12 @@ setGHCiState s = GHCi $ \r -> writeIORef r s
-- for convenience...
getSession = getGHCiState >>= return . session
GLOBAL_VAR(saved_sess, no_saved_sess, Session)
no_saved_sess = error "no saved_ses"
saveSession = getSession >>= io . writeIORef saved_sess
splatSavedSession = io (writeIORef saved_sess no_saved_sess)
restoreSession = readIORef saved_sess
getDynFlags = do
s <- getSession
io (GHC.getSessionDynFlags s)
......
......@@ -62,6 +62,7 @@ module GHC (
#ifdef GHCI
setContext, getContext,
getNamesInScope,
getRdrNamesInScope,
moduleIsInterpreted,
getInfo,
exprType,
......@@ -83,6 +84,7 @@ module GHC (
Name,
nameModule, nameParent_maybe, pprParenSymName, nameSrcLoc,
NamedThing(..),
RdrName(Qual,Unqual),
-- ** Identifiers
Id, idType,
......@@ -176,7 +178,7 @@ import GHC.Exts ( unsafeCoerce# )
import Packages ( initPackages )
import NameSet ( NameSet, nameSetToList, elemNameSet )
import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName,
import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName(..),
globalRdrEnvElts )
import HsSyn
import Type ( Kind, Type, dropForAlls, PredType, ThetaType,
......@@ -199,7 +201,7 @@ import DataCon ( DataCon, dataConWrapId, dataConSig, dataConTyCon,
dataConFieldLabels, dataConStrictMarks,
dataConIsInfix, isVanillaDataCon )
import Name ( Name, nameModule, NamedThing(..), nameParent_maybe,
nameSrcLoc )
nameSrcLoc, nameOccName )
import OccName ( parenSymOcc )
import NameEnv ( nameEnvElts )
import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
......@@ -1887,6 +1889,25 @@ getNamesInScope :: Session -> IO [Name]
getNamesInScope s = withSession s $ \hsc_env -> do
return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
getRdrNamesInScope :: Session -> IO [RdrName]
getRdrNamesInScope s = withSession s $ \hsc_env -> do
let env = ic_rn_gbl_env (hsc_IC hsc_env)
return (concat (map greToRdrNames (globalRdrEnvElts env)))
-- ToDo: move to RdrName
greToRdrNames :: GlobalRdrElt -> [RdrName]
greToRdrNames GRE{ gre_name = name, gre_prov = prov }
= case prov of
LocalDef -> [unqual]
Imported specs -> concat (map do_spec (map is_decl specs))
where
occ = nameOccName name
unqual = Unqual occ
do_spec decl_spec
| is_qual decl_spec = [qual]
| otherwise = [unqual,qual]
where qual = Qual (is_as decl_spec) occ
-- | Parses a string as an identifier, and returns the list of 'Name's that
-- the identifier can refer to in the current interactive context.
parseName :: Session -> String -> IO [Name]
......
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