summaryrefslogtreecommitdiff
path: root/ghc
diff options
context:
space:
mode:
authorunknown <simonpj@MSRC-4971295.europe.corp.microsoft.com>2013-10-01 16:34:00 +0100
committerunknown <simonpj@MSRC-4971295.europe.corp.microsoft.com>2013-10-01 16:54:58 +0100
commit66c5ddba449e78a174e989ea35783eb6c793e483 (patch)
tree6c29d5f2b99b1b4e7d7ebe79b21d3a999ea6ad4a /ghc
parentbceeb0167804e3325b48d4b360fddd68e29735a2 (diff)
downloadhaskell-66c5ddba449e78a174e989ea35783eb6c793e483.tar.gz
Improve pretty-printing of types
* The main change is to suppress printing (in types) of kind for-alls kind applications The new flag -fprint-explicit-kinds prints them as before (by analogy with the existing -fprint-explicit-foralls) * I also took advantage of the fact that SDoc now has access to DynFlags, to tidy up the way in which explicit for-alls are printed. Instead of passing a boolean flag around, we now simply consult the DynFlags. Much neater. I still need to add documentation for the flag
Diffstat (limited to 'ghc')
-rw-r--r--ghc/InteractiveUI.hs52
1 files changed, 20 insertions, 32 deletions
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 220ee17b5a..4715474623 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1062,12 +1062,10 @@ info allInfo s = handleSourceError GHC.printException $ do
infoThing :: GHC.GhcMonad m => Bool -> String -> m SDoc
infoThing allInfo str = do
- dflags <- getDynFlags
- let pefas = gopt Opt_PrintExplicitForalls dflags
names <- GHC.parseName str
mb_stuffs <- mapM (GHC.getInfo allInfo) names
let filtered = filterOutChildren (\(t,_f,_ci,_fi) -> t) (catMaybes mb_stuffs)
- return $ vcat (intersperse (text "") $ map (pprInfo pefas) filtered)
+ return $ vcat (intersperse (text "") $ map pprInfo filtered)
-- Filter out names whose parent is also there Good
-- example is '[]', which is both a type and data
@@ -1081,10 +1079,9 @@ filterOutChildren get_thing xs
Just p -> getName p `elemNameSet` all_names
Nothing -> False
-pprInfo :: PrintExplicitForalls
- -> (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
-pprInfo pefas (thing, fixity, cls_insts, fam_insts)
- = pprTyThingInContextLoc pefas thing
+pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
+pprInfo (thing, fixity, cls_insts, fam_insts)
+ = pprTyThingInContextLoc thing
$$ show_fixity
$$ vcat (map GHC.pprInstance cls_insts)
$$ vcat (map GHC.pprFamInst fam_insts)
@@ -1463,9 +1460,7 @@ typeOfExpr str
= handleSourceError GHC.printException
$ do
ty <- GHC.exprType str
- dflags <- getDynFlags
- let pefas = gopt Opt_PrintExplicitForalls dflags
- printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
+ printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser ty)]
-----------------------------------------------------------------------------
-- :kind
@@ -1475,9 +1470,7 @@ kindOfType norm str
= handleSourceError GHC.printException
$ do
(ty, kind) <- GHC.typeKind norm str
- dflags <- getDynFlags
- let pefas = gopt Opt_PrintExplicitForalls dflags
- printForUser $ vcat [ text str <+> dcolon <+> pprTypeForUser pefas kind
+ printForUser $ vcat [ text str <+> dcolon <+> pprTypeForUser kind
, ppWhen norm $ equals <+> ppr ty ]
@@ -1651,8 +1644,7 @@ browseModule bang modl exports_only = do
rdr_env <- GHC.getGRE
- let pefas = gopt Opt_PrintExplicitForalls dflags
- things | bang = catMaybes mb_things
+ let things | bang = catMaybes mb_things
| otherwise = filtered_things
pretty | bang = pprTyThing
| otherwise = pprTyThingInContext
@@ -1682,7 +1674,7 @@ browseModule bang modl exports_only = do
where (g,ng) = partition ((==m).fst) mts
let prettyThings, prettyThings' :: [SDoc]
- prettyThings = map (pretty pefas) things
+ prettyThings = map pretty things
prettyThings' | bang = annotate $ zip modNames prettyThings
| otherwise = prettyThings
liftIO $ putStrLn $ showSDocForUser dflags unqual (vcat prettyThings')
@@ -1990,12 +1982,13 @@ showDynFlags show_all dflags = do
(ghciFlags,others) = partition (\(_, f, _) -> f `elem` flgs)
DynFlags.fFlags
- flgs = [Opt_PrintExplicitForalls
- ,Opt_PrintBindResult
- ,Opt_BreakOnException
- ,Opt_BreakOnError
- ,Opt_PrintEvldWithShow
- ]
+ flgs = [ Opt_PrintExplicitForalls
+ , Opt_PrintKindArgs
+ , Opt_PrintBindResult
+ , Opt_BreakOnException
+ , Opt_BreakOnError
+ , Opt_PrintEvldWithShow
+ ]
setArgs, setOptions :: [String] -> GHCi ()
setProg, setEditor, setStop :: String -> GHCi ()
@@ -2254,15 +2247,12 @@ showBindings = do
where
makeDoc (AnId i) = pprTypeAndContents i
makeDoc tt = do
- dflags <- getDynFlags
- let pefas = gopt Opt_PrintExplicitForalls dflags
mb_stuff <- GHC.getInfo False (getName tt)
- return $ maybe (text "") (pprTT pefas) mb_stuff
+ return $ maybe (text "") pprTT mb_stuff
- pprTT :: PrintExplicitForalls
- -> (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
- pprTT pefas (thing, fixity, _cls_insts, _fam_insts) =
- pprTyThing pefas thing
+ pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
+ pprTT (thing, fixity, _cls_insts, _fam_insts)
+ = pprTyThing thing
$$ show_fixity
where
show_fixity
@@ -2271,9 +2261,7 @@ showBindings = do
printTyThing :: TyThing -> GHCi ()
-printTyThing tyth = do dflags <- getDynFlags
- let pefas = gopt Opt_PrintExplicitForalls dflags
- printForUser (pprTyThing pefas tyth)
+printTyThing tyth = printForUser (pprTyThing tyth)
showBkptTable :: GHCi ()
showBkptTable = do