X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=e0c49ceed6928e3489e84d667370306085d995cb;hb=831a35dd00faff195cf938659c2dd736192b865f;hp=a0c76ec52ef8f3279536d00221f101941eeef1fc;hpb=b70f35afc1c606dc85e6feb7da74be72411f58c1;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index a0c76ec..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,25 +14,28 @@ 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 ) + 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, printForUserPartWay) import Module -- for ModuleEnv @@ -37,6 +43,7 @@ import Name import SrcLoc -- Other random utilities +import CmdLineParser import Digraph import BasicTypes hiding (isTopLevel) import Panic hiding (showException) @@ -45,9 +52,10 @@ 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) @@ -56,16 +64,17 @@ import GHC.ConsoleHandler ( flushConsole ) 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 @@ -76,21 +85,17 @@ import System.Directory import System.IO import System.IO.Error as IO import Data.Char -import Data.Dynamic import Data.Array import Control.Monad as Monad import Text.Printf import Foreign -import Foreign.C ( withCStringLen ) +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 @@ -100,7 +105,6 @@ ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++ cmdName :: Command -> String cmdName (n,_,_,_) = n -macros_ref :: IORef [Command] GLOBAL_VAR(macros_ref, [], [Command]) builtin_commands :: [Command] @@ -137,8 +141,9 @@ builtin_commands = [ ("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, completeNone), + ("show", keepGoing showCmd, Nothing, completeShowOptions), ("sprint", keepGoing sprintCmd, Nothing, completeIdentifier), ("step", keepGoing stepCmd, Nothing, completeIdentifier), ("steplocal", keepGoing stepLocalCmd, Nothing, completeIdentifier), @@ -158,11 +163,15 @@ builtin_commands = [ -- -- NOTE: in order for us to override the default correctly, any custom entry -- must be a SUBSET of word_break_chars. -word_break_chars, flagWordBreakChars, filenameWordBreakChars :: String +#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 @@ -171,7 +180,11 @@ 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" @@ -183,7 +196,7 @@ helpText = " evaluate/run \n" ++ " : repeat last command\n" ++ " :{\\n ..lines.. \\n:}\\n multiline command\n" ++ - " :add ... add module(s) to the current target set\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" ++ @@ -196,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" ++ @@ -216,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" ++ @@ -234,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