X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=54788af28b0a58a1d41ce8bcf80180041a456c7d;hb=fea8c9e4b1ef4973aa577f29b59d35ee12472ebb;hp=c574a8a8465b98cc320b6633cd9e49bbfef3f557;hpb=6c9010f6ea6a7cb9feea45b3a5c06db0d4f7d3b2;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index c574a8a..54788af 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -23,6 +23,7 @@ import DynFlags import Packages import PackageConfig import UniqFM +import HscTypes ( implicitTyThings ) import PprTyThing import Outputable hiding (printForUser) import Module -- for ModuleEnv @@ -36,6 +37,8 @@ import Config import StaticFlags import Linker import Util +import NameSet +import Maybes ( orElse ) import FastString #ifndef mingw32_HOST_OS @@ -157,8 +160,8 @@ helpText = " :info [ ...] display information about the given names\n" ++ " :kind show the kind of \n" ++ " :load ... load module(s) and their dependents\n" ++ - " :module [+/-] [*] ... set the context for expression evaluation\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" ++ " :type show the type of \n" ++ @@ -667,23 +670,22 @@ info s = do { let names = words s ; mapM_ (infoThing pefas session) names } where infoThing pefas session str = io $ do - names <- GHC.parseName session str - let filtered = filterOutChildren names - mb_stuffs <- mapM (GHC.getInfo session) filtered + names <- GHC.parseName session str + mb_stuffs <- mapM (GHC.getInfo session) names + let filtered = filterOutChildren (\(t,f,i) -> t) (catMaybes mb_stuffs) unqual <- GHC.getPrintUnqual session putStrLn (showSDocForUser unqual $ vcat (intersperse (text "") $ - [ pprInfo pefas stuff | Just stuff <- mb_stuffs ])) + map (pprInfo pefas) filtered)) -- Filter out names whose parent is also there Good -- example is '[]', which is both a type and data -- constructor in the same type -filterOutChildren :: [Name] -> [Name] -filterOutChildren names = filter (not . parent_is_there) names - where parent_is_there n --- | Just p <- GHC.nameParent_maybe n = p `elem` names --- ToDo!! - | otherwise = False +filterOutChildren :: (a -> TyThing) -> [a] -> [a] +filterOutChildren get_thing xs + = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)] + where + implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)] pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc pprInfo pefas (thing, fixity, insts) @@ -994,16 +996,16 @@ browseModule m exports_only = do Just mod_info -> do let names | exports_only = GHC.modInfoExports mod_info - | otherwise = fromMaybe [] (GHC.modInfoTopLevelScope mod_info) + | otherwise = GHC.modInfoTopLevelScope mod_info + `orElse` [] - filtered = filterOutChildren names - - things <- io $ mapM (GHC.lookupName s) filtered + mb_things <- io $ mapM (GHC.lookupName s) names + let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things) dflags <- getDynFlags let pefas = dopt Opt_PrintExplicitForalls dflags io (putStrLn (showSDocForUser unqual ( - vcat (map (pprTyThingInContext pefas) (catMaybes things)) + vcat (map (pprTyThingInContext pefas) filtered_things) ))) -- ToDo: modInfoInstances currently throws an exception for -- package modules. When it works, we can do this: @@ -1642,14 +1644,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