X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=e0c49ceed6928e3489e84d667370306085d995cb;hb=831a35dd00faff195cf938659c2dd736192b865f;hp=c0346fb3f29abfb83020b9825139e34626a5389f;hpb=7bd518ddd4113c3cdc2497c6383f3b02f609486f;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index c0346fb..e0c49ce 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -1,3 +1,6 @@ +{-# OPTIONS -fno-cse #-} +-- -fno-cse is needed for GLOBAL_VAR's to behave properly + {-# OPTIONS -#include "Linker.h" #-} ----------------------------------------------------------------------------- -- @@ -11,32 +14,36 @@ module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where #include "HsVersions.h" -import GhciMonad +import qualified GhciMonad +import GhciMonad hiding (runStmt) import GhciTags import Debugger -- The GHC interface -import qualified GHC -import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..), +import qualified GHC hiding (resume, runStmt) +import GHC ( LoadHowMuch(..), Target(..), TargetId(..), Module, ModuleName, TyThing(..), Phase, - BreakIndex, SrcSpan, Resume, SingleStep, Id ) + BreakIndex, SrcSpan, Resume, SingleStep, + Ghc, handleSourceError ) import PprTyThing import DynFlags import Packages -#ifdef USE_READLINE +#ifdef USE_EDITLINE import PackageConfig import UniqFM #endif -import HscTypes ( implicitTyThings ) +import HscTypes ( implicitTyThings, reflectGhc, reifyGhc + , handleFlagWarnings ) import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC? -import Outputable hiding (printForUser) +import Outputable hiding (printForUser, printForUserPartWay) import Module -- for ModuleEnv import Name import SrcLoc -- Other random utilities +import CmdLineParser import Digraph import BasicTypes hiding (isTopLevel) import Panic hiding (showException) @@ -45,27 +52,29 @@ import StaticFlags import Linker import Util import NameSet -import Maybes ( orElse ) +import Maybes ( orElse, expectJust ) import FastString +import Encoding +import MonadUtils ( liftIO ) #ifndef mingw32_HOST_OS import System.Posix hiding (getEnv) #else import GHC.ConsoleHandler ( flushConsole ) -import System.Win32 ( setConsoleCP, setConsoleOutputCP ) import qualified System.Win32 #endif -#ifdef USE_READLINE +#ifdef USE_EDITLINE import Control.Concurrent ( yield ) -- Used in readline loop -import System.Console.Readline as Readline +import System.Console.Editline.Readline as Readline #endif --import SystemExts -import Control.Exception as Exception +import Exception -- import Control.Concurrent +import System.FilePath import qualified Data.ByteString.Char8 as BS import Data.List import Data.Maybe @@ -75,88 +84,107 @@ import System.Exit ( exitWith, ExitCode(..) ) import System.Directory import System.IO import System.IO.Error as IO -import System.IO.Unsafe import Data.Char -import Data.Dynamic import Data.Array import Control.Monad as Monad import Text.Printf - -import Foreign.StablePtr ( newStablePtr ) +import Foreign +import Foreign.C import GHC.Exts ( unsafeCoerce# ) import GHC.IOBase ( IOErrorType(InvalidArgument) ) +import GHC.TopHandler import Data.IORef ( IORef, readIORef, writeIORef ) -#ifdef USE_READLINE -import System.Posix.Internals ( setNonBlockingFD ) -#endif - ----------------------------------------------------------------------------- ghciWelcomeMsg :: String ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++ ": http://www.haskell.org/ghc/ :? for help" -type Command = (String, String -> GHCi Bool, Bool, String -> IO [String]) - cmdName :: Command -> String cmdName (n,_,_,_) = n -macros_ref :: IORef [Command] GLOBAL_VAR(macros_ref, [], [Command]) builtin_commands :: [Command] builtin_commands = [ -- Hugs users are accustomed to :e, so make sure it doesn't overlap - ("?", keepGoing help, False, completeNone), - ("add", keepGoingPaths addModule, False, completeFilename), - ("abandon", keepGoing abandonCmd, False, completeNone), - ("break", keepGoing breakCmd, False, completeIdentifier), - ("back", keepGoing backCmd, False, completeNone), - ("browse", keepGoing (browseCmd False), False, completeModule), - ("browse!", keepGoing (browseCmd True), False, completeModule), - ("cd", keepGoing changeDirectory, False, completeFilename), - ("check", keepGoing checkModule, False, completeHomeModule), - ("continue", keepGoing continueCmd, False, completeNone), - ("cmd", keepGoing cmdCmd, False, completeIdentifier), - ("ctags", keepGoing createCTagsFileCmd, False, completeFilename), - ("def", keepGoing (defineMacro False), False, completeIdentifier), - ("def!", keepGoing (defineMacro True), False, completeIdentifier), - ("delete", keepGoing deleteCmd, False, completeNone), - ("e", keepGoing editFile, False, completeFilename), - ("edit", keepGoing editFile, False, completeFilename), - ("etags", keepGoing createETagsFileCmd, False, completeFilename), - ("force", keepGoing forceCmd, False, completeIdentifier), - ("forward", keepGoing forwardCmd, False, completeNone), - ("help", keepGoing help, False, completeNone), - ("history", keepGoing historyCmd, False, completeNone), - ("info", keepGoing info, False, completeIdentifier), - ("kind", keepGoing kindOfType, False, completeIdentifier), - ("load", keepGoingPaths loadModule_, False, completeHomeModuleOrFile), - ("list", keepGoing listCmd, False, completeNone), - ("module", keepGoing setContext, False, completeModule), - ("main", keepGoing runMain, False, completeIdentifier), - ("print", keepGoing printCmd, False, completeIdentifier), - ("quit", quit, False, completeNone), - ("reload", keepGoing reloadModule, False, completeNone), - ("set", keepGoing setCmd, True, completeSetOptions), - ("show", keepGoing showCmd, False, completeNone), - ("sprint", keepGoing sprintCmd, False, completeIdentifier), - ("step", keepGoing stepCmd, False, completeIdentifier), - ("steplocal", keepGoing stepLocalCmd, False, completeIdentifier), - ("stepmodule",keepGoing stepModuleCmd, False, completeIdentifier), - ("type", keepGoing typeOfExpr, False, completeIdentifier), - ("trace", keepGoing traceCmd, False, completeIdentifier), - ("undef", keepGoing undefineMacro, False, completeMacro), - ("unset", keepGoing unsetOptions, True, completeSetOptions) + ("?", keepGoing help, Nothing, completeNone), + ("add", keepGoingPaths addModule, Just filenameWordBreakChars, completeFilename), + ("abandon", keepGoing abandonCmd, Nothing, completeNone), + ("break", keepGoing breakCmd, Nothing, completeIdentifier), + ("back", keepGoing backCmd, Nothing, completeNone), + ("browse", keepGoing (browseCmd False), Nothing, completeModule), + ("browse!", keepGoing (browseCmd True), Nothing, completeModule), + ("cd", keepGoing changeDirectory, Just filenameWordBreakChars, completeFilename), + ("check", keepGoing checkModule, Nothing, completeHomeModule), + ("continue", keepGoing continueCmd, Nothing, completeNone), + ("cmd", keepGoing cmdCmd, Nothing, completeIdentifier), + ("ctags", keepGoing createCTagsFileCmd, Just filenameWordBreakChars, completeFilename), + ("def", keepGoing (defineMacro False), Nothing, completeIdentifier), + ("def!", keepGoing (defineMacro True), Nothing, completeIdentifier), + ("delete", keepGoing deleteCmd, Nothing, completeNone), + ("e", keepGoing editFile, Just filenameWordBreakChars, completeFilename), + ("edit", keepGoing editFile, Just filenameWordBreakChars, completeFilename), + ("etags", keepGoing createETagsFileCmd, Just filenameWordBreakChars, completeFilename), + ("force", keepGoing forceCmd, Nothing, completeIdentifier), + ("forward", keepGoing forwardCmd, Nothing, completeNone), + ("help", keepGoing help, Nothing, completeNone), + ("history", keepGoing historyCmd, Nothing, completeNone), + ("info", keepGoing info, Nothing, completeIdentifier), + ("kind", keepGoing kindOfType, Nothing, completeIdentifier), + ("load", keepGoingPaths loadModule_, Just filenameWordBreakChars, completeHomeModuleOrFile), + ("list", keepGoing listCmd, Nothing, completeNone), + ("module", keepGoing setContext, Nothing, completeModule), + ("main", keepGoing runMain, Nothing, completeIdentifier), + ("print", keepGoing printCmd, Nothing, completeIdentifier), + ("quit", quit, Nothing, completeNone), + ("reload", keepGoing reloadModule, Nothing, completeNone), + ("run", keepGoing runRun, Nothing, completeIdentifier), + ("set", keepGoing setCmd, Just flagWordBreakChars, completeSetOptions), + ("show", keepGoing showCmd, Nothing, completeShowOptions), + ("sprint", keepGoing sprintCmd, Nothing, completeIdentifier), + ("step", keepGoing stepCmd, Nothing, completeIdentifier), + ("steplocal", keepGoing stepLocalCmd, Nothing, completeIdentifier), + ("stepmodule",keepGoing stepModuleCmd, Nothing, completeIdentifier), + ("type", keepGoing typeOfExpr, Nothing, completeIdentifier), + ("trace", keepGoing traceCmd, Nothing, completeIdentifier), + ("undef", keepGoing undefineMacro, Nothing, completeMacro), + ("unset", keepGoing unsetOptions, Just flagWordBreakChars, completeSetOptions) ] + +-- We initialize readline (in the interactiveUI function) to use +-- word_break_chars as the default set of completion word break characters. +-- This can be overridden for a particular command (for example, filename +-- expansion shouldn't consider '/' to be a word break) by setting the third +-- entry in the Command tuple above. +-- +-- NOTE: in order for us to override the default correctly, any custom entry +-- must be a SUBSET of word_break_chars. +#ifdef USE_EDITLINE +word_break_chars :: String +word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~" + specials = "(),;[]`{}" + spaces = " \t\n" + in spaces ++ specials ++ symbols +#endif + +flagWordBreakChars, filenameWordBreakChars :: String +flagWordBreakChars = " \t\n" +filenameWordBreakChars = " \t\n\\`@$><=;|&{(" -- bash defaults + + keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool) keepGoing a str = a str >> return False keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool) -keepGoingPaths a str = a (toArgs str) >> return False +keepGoingPaths a str + = do case toArgs str of + Left err -> io (hPutStrLn stderr err) + Right args -> a args + return False shortHelpText :: String shortHelpText = "use :? for help.\n" @@ -166,10 +194,11 @@ helpText = " Commands available from the prompt:\n" ++ "\n" ++ " evaluate/run \n" ++ + " : repeat last command\n" ++ " :{\\n ..lines.. \\n:}\\n multiline command\n" ++ - " :add ... add module(s) to the current target set\n" ++ - " :browse[!] [-s] [[*]] display the names defined by module \n" ++ - " (!: more details; -s: sort; *: all top-level names)\n" ++ + " :add [*] ... add module(s) to the current target set\n" ++ + " :browse[!] [[*]] display the names defined by module \n" ++ + " (!: more details; *: all top-level names)\n" ++ " :cd change directory to \n" ++ " :cmd run the commands returned by ::IO String\n" ++ " :ctags [] create tags file for Vi (default: \"tags\")\n" ++ @@ -180,11 +209,12 @@ helpText = " :help, :? display this list of commands\n" ++ " :info [ ...] display information about the given names\n" ++ " :kind show the kind of \n" ++ - " :load ... load module(s) and their dependents\n" ++ + " :load [*] ... load module(s) and their dependents\n" ++ " :main [ ...] run the main function with the given arguments\n" ++ " :module [+/-] [*] ... set the context for expression evaluation\n" ++ " :quit exit GHCi\n" ++ " :reload reload the current module set\n" ++ + " :run function [ ...] run the function with the given arguments\n" ++ " :type show the type of \n" ++ " :undef undefine user-defined command :\n" ++ " :! run the shell command \n" ++ @@ -200,15 +230,18 @@ helpText = " :delete * delete all breakpoints\n" ++ " :force print , forcing unevaluated parts\n" ++ " :forward go forward in the history (after :back)\n" ++ - " :history [] show the last items in the history (after :trace)\n" ++ + " :history [] after :trace, show the execution history\n" ++ + " :list show the source code around current breakpoint\n" ++ + " :list identifier show the source code for \n" ++ + " :list [] show the source code around line number \n" ++ " :print [ ...] prints a value without forcing its computation\n" ++ " :sprint [ ...] simplifed version of :print\n" ++ " :step single-step after stopping at a breakpoint\n"++ " :step single-step into \n"++ - " :steplocal single-step restricted to the current top level decl.\n"++ + " :steplocal single-step within the current top-level binding\n"++ " :stepmodule single-step restricted to the current module\n"++ " :trace trace after stopping at a breakpoint\n"++ - " :trace trace into (remembers breakpoints for :history)\n"++ + " :trace evaluate with tracing on (see :history)\n"++ "\n" ++ " -- Commands for changing settings:\n" ++ @@ -218,7 +251,7 @@ helpText = " :set prog set the value returned by System.getProgName\n" ++ " :set prompt set the prompt used in GHCi\n" ++ " :set editor set the command used for :edit\n" ++ - " :set stop set the command to run when a breakpoint is hit\n" ++ + " :set stop [] set the command to run when a breakpoint is hit\n" ++ " :unset