diff options
author | unknown <simonpj@MSRC-4971295.europe.corp.microsoft.com> | 2013-10-01 16:34:00 +0100 |
---|---|---|
committer | unknown <simonpj@MSRC-4971295.europe.corp.microsoft.com> | 2013-10-01 16:54:58 +0100 |
commit | 66c5ddba449e78a174e989ea35783eb6c793e483 (patch) | |
tree | 6c29d5f2b99b1b4e7d7ebe79b21d3a999ea6ad4a /ghc | |
parent | bceeb0167804e3325b48d4b360fddd68e29735a2 (diff) | |
download | haskell-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.hs | 52 |
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 |