X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=2497bada366f2054294a1bac73af41039934ffc2;hb=d061166982c65f8e61b4faf942bc5737da2b272c;hp=91ce0f444f60af516a6027a45f02b6ef5c9b33f5;hpb=98b004a37fdfe0347eaaf379789ac0d595f70f25;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 91ce0f4..2497bad 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -8,7 +8,8 @@ ----------------------------------------------------------------------------- module InteractiveUI ( interactiveUI, - ghciWelcomeMsg + ghciWelcomeMsg, + ghciShortWelcomeMsg ) where #include "HsVersions.h" @@ -41,10 +42,7 @@ import Util import FastString #ifndef mingw32_HOST_OS -import System.Posix -#if __GLASGOW_HASKELL__ > 504 - hiding (getEnv) -#endif +import System.Posix hiding (getEnv) #else import GHC.ConsoleHandler ( flushConsole ) import System.Win32 ( setConsoleCP, setConsoleOutputCP ) @@ -93,6 +91,10 @@ ghciWelcomeMsg = "/ /_\\\\/ __ / /___| | http://www.haskell.org/ghc/\n"++ "\\____/\\/ /_/\\____/|_| Type :? for help.\n" +ghciShortWelcomeMsg = + "GHCi, version " ++ cProjectVersion ++ + ": http://www.haskell.org/ghc/ :? for help" + type Command = (String, String -> GHCi Bool, Bool, String -> IO [String]) cmdName (n,_,_,_) = n @@ -155,7 +157,7 @@ helpText = " :add ... add module(s) to the current target set\n" ++ " :browse [*] display the names defined by \n" ++ " :cd change directory to \n" ++ - " :cmd run the commands returned by ::IO String"++ + " :cmd run the commands returned by ::IO String\n" ++ " :ctags [] create tags file for Vi (default: \"tags\")\n" ++ " :def define a command :\n" ++ " :edit edit file\n" ++ @@ -555,6 +557,7 @@ runCommandEval c = ghciHandle handleEval (doCommand c) runStmt :: String -> SingleStep -> GHCi Bool runStmt stmt step | null (filter (not.isSpace) stmt) = return False + | ["import", mod] <- words stmt = keepGoing setContext ('+':mod) | otherwise = do st <- getGHCiState session <- getSession @@ -721,25 +724,47 @@ changeDirectory dir = do io (setCurrentDirectory dir) editFile :: String -> GHCi () -editFile str - | null str = do - -- find the name of the "topmost" file loaded - session <- getSession - graph0 <- io (GHC.getModuleGraph session) - graph1 <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph0 - let graph2 = flattenSCCs (GHC.topSortModuleGraph True graph1 Nothing) - case GHC.ml_hs_file (GHC.ms_location (last graph2)) of - Just file -> do_edit file - Nothing -> throwDyn (CmdLineError "unknown file name") - | otherwise = do_edit str - where - do_edit file = do - st <- getGHCiState - let cmd = editor st - when (null cmd) $ - throwDyn (CmdLineError "editor not set, use :set editor") - io $ system (cmd ++ ' ':file) - return () +editFile str = + do file <- if null str then chooseEditFile else return str + st <- getGHCiState + let cmd = editor st + when (null cmd) + $ throwDyn (CmdLineError "editor not set, use :set editor") + io $ system (cmd ++ ' ':file) + return () + +-- The user didn't specify a file so we pick one for them. +-- Our strategy is to pick the first module that failed to load, +-- or otherwise the first target. +-- +-- XXX: Can we figure out what happened if the depndecy analysis fails +-- (e.g., because the porgrammeer mistyped the name of a module)? +-- XXX: Can we figure out the location of an error to pass to the editor? +-- XXX: if we could figure out the list of errors that occured during the +-- last load/reaload, then we could start the editor focused on the first +-- of those. +chooseEditFile :: GHCi String +chooseEditFile = + do session <- getSession + let hasFailed x = io $ fmap not $ GHC.isLoaded session $ GHC.ms_mod_name x + + graph <- io (GHC.getModuleGraph session) + failed_graph <- filterM hasFailed graph + let order g = flattenSCCs $ GHC.topSortModuleGraph True g Nothing + pick xs = case xs of + x : _ -> GHC.ml_hs_file (GHC.ms_location x) + _ -> Nothing + + case pick (order failed_graph) of + Just file -> return file + Nothing -> + do targets <- io (GHC.getTargets session) + case msum (map fromTarget targets) of + Just file -> return file + Nothing -> throwDyn (CmdLineError "No files to edit.") + + where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f + fromTarget _ = Nothing -- when would we get a module target? defineMacro :: String -> GHCi () defineMacro s = do @@ -844,17 +869,12 @@ checkModule m = do afterLoad (successIf (isJust result)) session reloadModule :: String -> GHCi () -reloadModule "" = do - io (revertCAFs) -- always revert CAFs on reload. - discardActiveBreakPoints - session <- getSession - doLoad session LoadAllTargets - return () reloadModule m = do io (revertCAFs) -- always revert CAFs on reload. discardActiveBreakPoints session <- getSession - doLoad session (LoadUpTo (GHC.mkModuleName m)) + doLoad session $ if null m then LoadAllTargets + else LoadUpTo (GHC.mkModuleName m) return () doLoad session howmuch = do @@ -1453,6 +1473,10 @@ wantNameFromInterpretedModule noCanDo str and_then = do [] -> return () (n:_) -> do let modl = GHC.nameModule n + if not (GHC.isExternalName n) + then noCanDo n $ ppr n <> + text " is not defined in an interpreted module" + else do is_interpreted <- io (GHC.moduleIsInterpreted session modl) if not is_interpreted then noCanDo n $ text "module " <> ppr modl <> @@ -1677,7 +1701,8 @@ findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray findBreakByCoord mb_file (line, col) arr | not (inRange (bounds arr) line) = Nothing | otherwise = - listToMaybe (sortBy rightmost contains) + listToMaybe (sortBy rightmost contains) `mplus` + listToMaybe (sortBy leftmost_smallest after_here) where ticks = arr ! line @@ -1689,6 +1714,10 @@ findBreakByCoord mb_file (line, col) arr | Just f <- mb_file = GHC.srcSpanFile span == f | otherwise = True + after_here = [ tick | tick@(nm,span) <- ticks, + GHC.srcSpanStartLine span == line, + GHC.srcSpanStartCol span >= col ] + leftmost_smallest (_,a) (_,b) = a `compare` b leftmost_largest (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b) @@ -1700,6 +1729,17 @@ spans :: SrcSpan -> (Int,Int) -> Bool spans span (l,c) = GHC.srcSpanStart span <= loc && loc <= GHC.srcSpanEnd span where loc = GHC.mkSrcLoc (GHC.srcSpanFile span) l c +-- for now, use ANSI bold on Unixy systems. On Windows, we add a line +-- of carets under the active expression instead. The Windows console +-- doesn't support ANSI escape sequences, and most Unix terminals +-- (including xterm) do, so this is a reasonable guess until we have a +-- proper termcap/terminfo library. +#if !defined(mingw32_TARGET_OS) +do_bold = True +#else +do_bold = False +#endif + start_bold = BS.pack "\ESC[1m" end_bold = BS.pack "\ESC[0m" @@ -1758,7 +1798,8 @@ listModuleLine modl line = do -- If the highlight flag is True, also highlight the span using -- start_bold/end_bold. listAround span do_highlight = do - contents <- BS.readFile (unpackFS file) + pwd <- getEnv "PWD" + contents <- BS.readFile (pwd `joinFileName` unpackFS file) let lines = BS.split '\n' contents these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $ @@ -1784,7 +1825,10 @@ listAround span do_highlight = do | otherwise = 1 pad_after = 1 - highlight no line + highlight | do_bold = highlight_bold + | otherwise = highlight_carets + + highlight_bold no line | no == line1 && no == line2 = let (a,r) = BS.splitAt col1 line (b,c) = BS.splitAt (col2-col1) r @@ -1798,6 +1842,20 @@ listAround span do_highlight = do BS.concat [a, end_bold, b] | otherwise = line + highlight_carets no line + | no == line1 && no == line2 + = BS.concat [line, nl, indent, BS.replicate col1 ' ', + BS.replicate (col2-col1) '^'] + | no == line1 + = BS.concat [line, nl, indent, BS.replicate col1 ' ', + BS.replicate (BS.length line-col1) '^'] + | no == line2 + = BS.concat [line, nl, indent, BS.replicate col2 '^'] + | otherwise = line + where + indent = BS.pack " " + nl = BS.singleton '\n' + -- -------------------------------------------------------------------------- -- Tick arrays