X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=169168f8f25ddcc461a1c29434bcc7f0cdfc6f8b;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hp=4494f229e22661d45a5ba619d3b9c03077cb6906;hpb=6a13ee14f604f5ab0178b326c24590402ee66615;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 4494f22..169168f 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -6,7 +6,7 @@ -- (c) The GHC Team 2005-2006 -- ----------------------------------------------------------------------------- -module InteractiveUI ( interactiveUI ) where +module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where #include "HsVersions.h" @@ -81,16 +81,9 @@ import System.Posix.Internals ( setNonBlockingFD ) ----------------------------------------------------------------------------- -ghciWelcomeMsg = - " ___ ___ _\n"++ - " / _ \\ /\\ /\\/ __(_)\n"++ - " / /_\\// /_/ / / | | GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++ - "/ /_\\\\/ __ / /___| | http://www.haskell.org/ghc/\n"++ - "\\____/\\/ /_/\\____/|_| Type :? for help.\n" - -ghciShortWelcomeMsg = - "GHCi, version " ++ cProjectVersion ++ - ": http://www.haskell.org/ghc/ :? for help" +ghciWelcomeMsg :: String +ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++ + ": http://www.haskell.org/ghc/ :? for help" type Command = (String, String -> GHCi Bool, Bool, String -> IO [String]) cmdName (n,_,_,_) = n @@ -366,11 +359,6 @@ runGHCi paths maybe_expr = do -- initialise the console if necessary io setUpConsole - let msg = if dopt Opt_ShortGhciBanner dflags - then ghciShortWelcomeMsg - else ghciWelcomeMsg - when (verbosity dflags >= 1) $ io $ putStrLn msg - -- enter the interactive loop interactiveLoop is_tty show_prompt Just expr -> do @@ -611,9 +599,11 @@ runBreakCmd info = do printTypeOfNames :: Session -> [Name] -> GHCi () printTypeOfNames session names - = mapM_ (printTypeOfName session) $ sortBy compareFun names + = mapM_ (printTypeOfName session) $ sortBy compareNames names + +compareNames :: Name -> Name -> Ordering +n1 `compareNames` n2 = compareWith n1 `compare` compareWith n2 where compareWith n = (getOccString n, getSrcSpan n) - compareFun n1 n2 = compareWith n1 `compare` compareWith n2 printTypeOfName :: Session -> Name -> GHCi () printTypeOfName session n @@ -638,7 +628,7 @@ lookupCommand str = do -- 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 + [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of [] -> return Nothing c:_ -> return (Just c) @@ -673,17 +663,17 @@ info "" = throwDyn (CmdLineError "syntax: ':i '") info s = do { let names = words s ; session <- getSession ; dflags <- getDynFlags - ; let exts = dopt Opt_GlasgowExts dflags - ; mapM_ (infoThing exts session) names } + ; let pefas = dopt Opt_PrintExplicitForalls dflags + ; mapM_ (infoThing pefas session) names } where - infoThing exts session str = io $ do + infoThing pefas session str = io $ do names <- GHC.parseName session str let filtered = filterOutChildren names mb_stuffs <- mapM (GHC.getInfo session) filtered unqual <- GHC.getPrintUnqual session putStrLn (showSDocForUser unqual $ vcat (intersperse (text "") $ - [ pprInfo exts stuff | Just stuff <- mb_stuffs ])) + [ pprInfo pefas stuff | Just stuff <- mb_stuffs ])) -- Filter out names whose parent is also there Good -- example is '[]', which is both a type and data @@ -695,8 +685,9 @@ filterOutChildren names = filter (not . parent_is_there) names -- ToDo!! | otherwise = False -pprInfo exts (thing, fixity, insts) - = pprTyThingInContextLoc exts thing +pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc +pprInfo pefas (thing, fixity, insts) + = pprTyThingInContextLoc pefas thing $$ show_fixity fixity $$ vcat (map GHC.pprInstance insts) where @@ -863,7 +854,7 @@ checkModule :: String -> GHCi () checkModule m = do let modl = GHC.mkModuleName m session <- getSession - result <- io (GHC.checkModule session modl) + result <- io (GHC.checkModule session modl False) case result of Nothing -> io $ putStrLn "Nothing" Just r -> io $ putStrLn (showSDoc ( @@ -1010,9 +1001,9 @@ browseModule m exports_only = do things <- io $ mapM (GHC.lookupName s) filtered dflags <- getDynFlags - let exts = dopt Opt_GlasgowExts dflags + let pefas = dopt Opt_PrintExplicitForalls dflags io (putStrLn (showSDocForUser unqual ( - vcat (map (pprTyThingInContext exts) (catMaybes things)) + vcat (map (pprTyThingInContext pefas) (catMaybes things)) ))) -- ToDo: modInfoInstances currently throws an exception for -- package modules. When it works, we can do this: @@ -1258,9 +1249,12 @@ showBindings = do s <- getSession unqual <- io (GHC.getPrintUnqual s) bindings <- io (GHC.getBindings s) - mapM_ printTyThing bindings + mapM_ printTyThing $ sortBy compareTyThings bindings return () +compareTyThings :: TyThing -> TyThing -> Ordering +t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2 + printTyThing :: TyThing -> GHCi () printTyThing (AnId id) = do ty' <- cleanType (GHC.idType id) @@ -1271,7 +1265,7 @@ printTyThing _ = return () cleanType :: Type -> GHCi Type cleanType ty = do dflags <- getDynFlags - if dopt Opt_GlasgowExts dflags + if dopt Opt_PrintExplicitForalls dflags then return ty else return $! GHC.dropForAlls ty @@ -1648,14 +1642,17 @@ breakByModule :: Session -> Module -> [String] -> GHCi () breakByModule session mod args@(arg1:rest) | all isDigit arg1 = do -- looks like a line number breakByModuleLine mod (read arg1) rest - | otherwise = io $ putStrLn "Invalid arguments to :break" +breakByModule session mod _ + = breakSyntax breakByModuleLine :: Module -> Int -> [String] -> GHCi () breakByModuleLine mod line args | [] <- args = findBreakAndSet mod $ findBreakByLine line | [col] <- args, all isDigit col = findBreakAndSet mod $ findBreakByCoord Nothing (line, read col) - | otherwise = io $ putStrLn "Invalid arguments to :break" + | otherwise = breakSyntax + +breakSyntax = throwDyn (CmdLineError "Syntax: :break [] []") findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi () findBreakAndSet mod lookupTickTree = do @@ -1808,8 +1805,7 @@ listModuleLine modl line = do -- If the highlight flag is True, also highlight the span using -- start_bold/end_bold. listAround span do_highlight = do - pwd <- getEnv "PWD" - contents <- BS.readFile (pwd `joinFileName` unpackFS file) + contents <- BS.readFile (unpackFS file) let lines = BS.split '\n' contents these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $