X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=54788af28b0a58a1d41ce8bcf80180041a456c7d;hb=3066cecc9311bdf188807c705cda73254785570a;hp=dd24d5bc96fd0a2b9620de076abfa11e00c1a82d;hpb=407e1a2b222459f91749500258257c203c84c287;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index dd24d5b..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 [<name> ...]          display information about the given names\n" ++
  "   :kind <type>                show the kind of <type>\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
- "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
+ "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :type <expr>                show the type of <expr>\n" ++
@@ -663,30 +666,30 @@ info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
 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
-	names <- GHC.parseName session str
-	let filtered = filterOutChildren names
-	mb_stuffs <- mapM (GHC.getInfo session) filtered
+    infoThing pefas session str = io $ do
+	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 exts 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
-
-pprInfo exts (thing, fixity, insts)
-  =  pprTyThingInContextLoc exts thing 
+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)
+  =  pprTyThingInContextLoc pefas thing
   $$ show_fixity fixity
   $$ vcat (map GHC.pprInstance insts)
   where
@@ -993,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 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) filtered_things)
 	   )))
 	-- ToDo: modInfoInstances currently throws an exception for
 	-- package modules.  When it works, we can do this:
@@ -1264,7 +1267,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
 
@@ -1641,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 [<mod>] <line> [<column>]")
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do