diff options
author | Patrick Dougherty <patrick.doc@ameritech.net> | 2017-07-11 11:53:40 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-07-11 13:41:44 -0400 |
commit | 905dc8bc74bebf5370eb9237cc8756cd9fe871ae (patch) | |
tree | 2d758be7928ef4ca2a1450f73b5301aa94b46628 | |
parent | 31ceaba3edac536d8a8d97d49bb797d4f5bedac6 (diff) | |
download | haskell-905dc8bc74bebf5370eb9237cc8756cd9fe871ae.tar.gz |
Make ':info Coercible' display an arbitrary string (fixes #12390)
This change enables the addition of an arbitrary string to the output of
GHCi's ':info'. It was made for Coercible in particular but could be
extended if desired.
Updates haddock submodule.
Test Plan: Modified test 'ghci059' to match new output.
Reviewers: austin, bgamari
Reviewed By: bgamari
Subscribers: goldfire, rwbarton, thomie
GHC Trac Issues: #12390
Differential Revision: https://phabricator.haskell.org/D3634
-rw-r--r-- | compiler/main/HscMain.hs | 3 | ||||
-rw-r--r-- | compiler/main/InteractiveEval.hs | 7 | ||||
-rw-r--r-- | compiler/prelude/PrelInfo.hs | 19 | ||||
-rw-r--r-- | compiler/prelude/TysWiredIn.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 7 | ||||
-rw-r--r-- | ghc/GHCi/UI.hs | 14 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/ghci059.stdout | 5 | ||||
m--------- | utils/haddock | 0 |
8 files changed, 43 insertions, 14 deletions
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 0f0ea4dc51..196e309caa 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -275,7 +275,8 @@ hscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do -- "name not found", and the Maybe in the return type -- is used to indicate that. -hscTcRnGetInfo :: HscEnv -> Name -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst])) +hscTcRnGetInfo :: HscEnv -> Name + -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)) hscTcRnGetInfo hsc_env0 name = runInteractiveHsc hsc_env0 $ do { hsc_env <- getHscEnv diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 8e396cc16a..88d5dbe57d 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -726,20 +726,21 @@ moduleIsInterpreted modl = withSession $ \h -> -- are in scope (qualified or otherwise). Otherwise we list a whole lot too many! -- The exact choice of which ones to show, and which to hide, is a judgement call. -- (see Trac #1581) -getInfo :: GhcMonad m => Bool -> Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst])) +getInfo :: GhcMonad m => Bool -> Name + -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst], SDoc)) getInfo allInfo name = withSession $ \hsc_env -> do mb_stuff <- liftIO $ hscTcRnGetInfo hsc_env name case mb_stuff of Nothing -> return Nothing - Just (thing, fixity, cls_insts, fam_insts) -> do + Just (thing, fixity, cls_insts, fam_insts, docs) -> do let rdr_env = ic_rn_gbl_env (hsc_IC hsc_env) -- Filter the instances based on whether the constituent names of their -- instance heads are all in scope. let cls_insts' = filter (plausible rdr_env . orphNamesOfClsInst) cls_insts fam_insts' = filter (plausible rdr_env . orphNamesOfFamInst) fam_insts - return (Just (thing, fixity, cls_insts', fam_insts')) + return (Just (thing, fixity, cls_insts', fam_insts', docs)) where plausible rdr_env names -- Dfun involving only names that are in ic_rn_glb_env diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 8e26d80a6a..47f41fbf73 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -21,6 +21,7 @@ module PrelInfo ( -- * Known-key names isKnownKeyName, lookupKnownKeyName, + lookupKnownNameInfo, -- ** Internal use -- | 'knownKeyNames' is exported to seed the original name cache only; @@ -59,6 +60,7 @@ import Id import Name import NameEnv import MkId +import Outputable import TysPrim import TysWiredIn import HscTypes @@ -66,7 +68,6 @@ import Class import TyCon import UniqFM import Util -import Panic import {-# SOURCE #-} TcTypeNats ( typeNatTyCons ) import Control.Applicative ((<|>)) @@ -197,6 +198,22 @@ isKnownKeyName n = knownKeysMap :: UniqFM Name knownKeysMap = listToUFM [ (nameUnique n, n) | n <- knownKeyNames ] +-- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by +-- GHCi's ':info' command. +lookupKnownNameInfo :: Name -> SDoc +lookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of + -- If we do find a doc, we add comment delimeters to make the output + -- of ':info' valid Haskell. + Nothing -> empty + Just doc -> vcat [text "{-", doc, text "-}"] + +-- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390) +knownNamesInfo :: NameEnv SDoc +knownNamesInfo = unitNameEnv coercibleTyConName $ + vcat [ text "Coercible is a special constraint with custom solving rules." + , text "It is not a class." + , text "Please see section 9.14.4 of the user's guide for details." ] + {- We let a lot of "non-standard" values be visible, so that we can make sense of them in interface pragmas. It's cool, though they all have diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 71ff0e18c6..28c6629a91 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -102,7 +102,7 @@ module TysWiredIn ( -- * Equality predicates heqTyCon, heqClass, heqDataCon, - coercibleTyCon, coercibleDataCon, coercibleClass, + coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass, -- * RuntimeRep and friends runtimeRepTyCon, vecCountTyCon, vecElemTyCon, diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 35f767d1da..c9c259e992 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -66,6 +66,7 @@ import HsSyn import IfaceSyn ( ShowSub(..), showToHeader ) import IfaceType( ShowForAllFlag(..) ) import PrelNames +import PrelInfo import RdrName import TcHsSyn import TcExpr @@ -2419,7 +2420,8 @@ tcRnLookupName' name = do tcRnGetInfo :: HscEnv -> Name - -> IO (Messages, Maybe (TyThing, Fixity, [ClsInst], [FamInst])) + -> IO ( Messages + , Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)) -- Used to implement :info in GHCi -- @@ -2439,7 +2441,8 @@ tcRnGetInfo hsc_env name ; thing <- tcRnLookupName' name ; fixity <- lookupFixityRn name ; (cls_insts, fam_insts) <- lookupInsts thing - ; return (thing, fixity, cls_insts, fam_insts) } + ; let info = lookupKnownNameInfo name + ; return (thing, fixity, cls_insts, fam_insts, info) } -- Lookup all class and family instances for a type constructor. diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 40bd0e59c3..d58724037f 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -1338,7 +1338,8 @@ infoThing :: GHC.GhcMonad m => Bool -> String -> m SDoc infoThing allInfo str = do names <- GHC.parseName str mb_stuffs <- mapM (GHC.getInfo allInfo) names - let filtered = filterOutChildren (\(t,_f,_ci,_fi) -> t) (catMaybes mb_stuffs) + let filtered = filterOutChildren (\(t,_f,_ci,_fi,_sd) -> t) + (catMaybes mb_stuffs) return $ vcat (intersperse (text "") $ map pprInfo filtered) -- Filter out names whose parent is also there Good @@ -1353,9 +1354,10 @@ filterOutChildren get_thing xs Just p -> getName p `elemNameSet` all_names Nothing -> False -pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc -pprInfo (thing, fixity, cls_insts, fam_insts) - = pprTyThingInContextLoc thing +pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc +pprInfo (thing, fixity, cls_insts, fam_insts, docs) + = docs + $$ pprTyThingInContextLoc thing $$ show_fixity $$ vcat (map GHC.pprInstance cls_insts) $$ vcat (map GHC.pprFamInst fam_insts) @@ -2828,8 +2830,8 @@ showBindings = do mb_stuff <- GHC.getInfo False (getName tt) return $ maybe (text "") pprTT mb_stuff - pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc - pprTT (thing, fixity, _cls_insts, _fam_insts) + pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc + pprTT (thing, fixity, _cls_insts, _fam_insts, _docs) = pprTyThing showToHeader thing $$ show_fixity where diff --git a/testsuite/tests/ghci/scripts/ghci059.stdout b/testsuite/tests/ghci/scripts/ghci059.stdout index 9f4e65b344..9e9adb9ff1 100644 --- a/testsuite/tests/ghci/scripts/ghci059.stdout +++ b/testsuite/tests/ghci/scripts/ghci059.stdout @@ -1,3 +1,8 @@ +{- +Coercible is a special constraint with custom solving rules. +It is not a class. +Please see section 9.14.4 of the user's guide for details. +-} type role Coercible representational representational class Coercible a b => Coercible (a :: k0) (b :: k0) -- Defined in ‘GHC.Types’ diff --git a/utils/haddock b/utils/haddock -Subproject a9f774fa3c12f9b8e093e46d58e7872d3d47895 +Subproject 7cecbd969298d5aa576750864a69fa5f70f71c3 |