Commit e6de0678 authored by simonmar's avatar simonmar
Browse files

[project @ 2005-06-15 12:03:19 by simonmar]

Re-implement GHCi's :info and :browse commands in terms of TyThings
rather than IfaceSyn.

The GHC API now exposes its internal types for Haskell entities:
TyCons, Classes, DataCons, Ids and Instances (collectively known as
TyThings), so we can inspect these directly to pretty-print
information about an entity.  Previously the internal representations
were converted to IfaceSyn for passing to InteractiveUI, but we can
now remove that code.

Some of the new code comes via Visual Haskell, but I've changed it
around a lot to fix various dark corners and properly print things
like GADTs.

The pretty-printing interfaces for TyThings are exposed by a new
module PprTyThing, which is implemented purely in terms of the GHC API
(and is probably a good source of sample code).  Visual Haskell should
be able to use the functions exported by this module directly.

Lots of new goodies are exported by the GHC module, mainly for
inspecting TyThings.
parent 3fad64f3
......@@ -27,6 +27,7 @@ module Id (
isImplicitId, isDeadBinder,
isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
isRecordSelector,
isClassOpId_maybe,
isPrimOpId, isPrimOpId_maybe,
isFCallId, isFCallId_maybe,
isDataConWorkId, isDataConWorkId_maybe, idDataCon,
......@@ -249,6 +250,10 @@ isRecordSelector id = case globalIdDetails id of
RecordSelId _ _ -> True
other -> False
isClassOpId_maybe id = case globalIdDetails id of
ClassOpId cls -> Just cls
_other -> Nothing
isPrimOpId id = case globalIdDetails id of
PrimOpId op -> True
other -> False
......
......@@ -19,7 +19,8 @@ import GHC ( Session, verbosity, dopt, DynFlag(..),
mkModule, pprModule, Type, Module, SuccessFlag(..),
TyThing(..), Name, LoadHowMuch(..), Phase,
GhcException(..), showGhcException,
CheckedModule(..) )
CheckedModule(..), SrcLoc )
import PprTyThing
import Outputable
-- for createtags (should these come via GHC?)
......@@ -28,17 +29,8 @@ import Name( nameSrcLoc, nameModule, nameOccName )
import OccName( pprOccName )
import SrcLoc( isGoodSrcLoc, srcLocFile, srcLocLine, srcLocCol )
-- following all needed for :info... ToDo: remove
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..),
IfaceConDecl(..), IfaceType,
pprIfaceDeclHead, pprParendIfaceType,
pprIfaceForAllPart, pprIfaceType )
import FunDeps ( pprFundeps )
import SrcLoc ( SrcLoc, pprDefnLoc )
import OccName ( OccName, parenSymOcc, occNameUserString )
import BasicTypes ( StrictnessMark(..), defaultFixity, failed, successIf )
-- Other random utilities
import BasicTypes ( failed, successIf )
import Panic ( panic, installSignalHandlers )
import Config
import StaticFlags ( opt_IgnoreDotGhci )
......@@ -70,7 +62,7 @@ import Data.Dynamic
import Numeric
import Data.List
import Data.Int ( Int64 )
import Data.Maybe ( isJust )
import Data.Maybe ( isJust, fromMaybe, catMaybes )
import System.Cmd
import System.CPUTime
import System.Environment
......@@ -536,126 +528,32 @@ info s = do { let names = words s
; let exts = dopt Opt_GlasgowExts dflags
; mapM_ (infoThing exts session) names }
where
infoThing exts session name
= do { stuff <- io (GHC.getInfo session name)
; unqual <- io (GHC.getPrintUnqual session)
; io (putStrLn (showSDocForUser unqual $
vcat (intersperse (text "") (map (showThing exts) stuff)))) }
showThing :: Bool -> GHC.GetInfoResult -> SDoc
showThing exts (wanted_str, thing, fixity, src_loc, insts)
= vcat [ showWithLoc src_loc (showDecl exts want_name thing),
show_fixity fixity,
vcat (map show_inst insts)]
infoThing exts session str = io $ do
names <- GHC.parseName session str
let filtered = filterOutChildren names
mb_stuffs <- mapM (GHC.getInfo session) filtered
unqual <- GHC.getPrintUnqual session
putStrLn (showSDocForUser unqual $
vcat (intersperse (text "") $
[ pprInfo exts stuff | Just stuff <- mb_stuffs ]))
-- 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
| otherwise = False
pprInfo exts (thing, fixity, insts)
= pprTyThingLoc exts thing
$$ show_fixity fixity
$$ vcat (map GHC.pprInstance insts)
where
want_name occ = wanted_str == occNameUserString occ
show_fixity fix
| fix == defaultFixity = empty
| otherwise = ppr fix <+> text wanted_str
show_inst (inst_ty, loc)
= showWithLoc loc (ptext SLIT("instance") <+> ppr inst_ty)
showWithLoc :: SrcLoc -> SDoc -> SDoc
showWithLoc loc doc
= hang doc 2 (char '\t' <> comment <+> pprDefnLoc loc)
-- The tab tries to make them line up a bit
where
comment = ptext SLIT("--")
-- Now there is rather a lot of goop just to print declarations in a
-- civilised way with "..." for the parts we are less interested in.
showDecl :: Bool -> (OccName -> Bool) -> IfaceDecl -> SDoc
showDecl exts want_name (IfaceForeign {ifName = tc})
= ppr tc <+> ptext SLIT("is a foreign type")
showDecl exts want_name (IfaceId {ifName = var, ifType = ty})
= ppr var <+> dcolon <+> showIfaceType exts ty
showDecl exts want_name (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = mono_ty})
= hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
2 (equals <+> ppr mono_ty)
showDecl exts want_name (IfaceData {ifName = tycon,
ifTyVars = tyvars, ifCons = condecls, ifCtxt = context})
= hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
2 (add_bars (ppr_trim show_con cs))
where
show_con (IfVanillaCon { ifConOcc = con_name, ifConInfix = is_infix, ifConArgTys = tys,
ifConStricts = strs, ifConFields = flds})
| want_name tycon || want_name con_name || any want_name flds
= Just (show_guts con_name is_infix tys_w_strs flds)
| otherwise = Nothing
where
tys_w_strs = tys `zip` (strs ++ repeat NotMarkedStrict)
show_con (IfGadtCon { ifConOcc = con_name, ifConTyVars = tvs, ifConCtxt = theta,
ifConArgTys = arg_tys, ifConResTys = res_tys, ifConStricts = strs })
| want_name tycon || want_name con_name
= Just (ppr_bndr con_name <+> colon <+> pprIfaceForAllPart tvs theta pp_tau)
| otherwise = Nothing
where
tys_w_strs = arg_tys `zip` (strs ++ repeat NotMarkedStrict)
pp_tau = foldr add pp_res_ty tys_w_strs
pp_res_ty = ppr_bndr tycon <+> hsep (map pprParendIfaceType res_tys)
add bty pp_ty = ppr_bangty bty <+> arrow <+> pp_ty
show_guts con True [ty1, ty2] flds = sep [ppr_bangty ty1, ppr con, ppr_bangty ty2]
show_guts con _ tys [] = ppr_bndr con <+> sep (map ppr_bangty tys)
show_guts con _ tys flds
= ppr_bndr con <+> braces (sep (punctuate comma (ppr_trim show_fld (tys `zip` flds))))
where
show_fld (bty, fld) | want_name tycon || want_name con || want_name fld
= Just (ppr_bndr fld <+> dcolon <+> ppr_bangty bty)
| otherwise = Nothing
(pp_nd, cs) = case condecls of
IfAbstractTyCon -> (ptext SLIT("data"), [])
IfDataTyCon cs -> (ptext SLIT("data"), cs)
IfNewTyCon c -> (ptext SLIT("newtype"),[c])
add_bars [] = empty
add_bars [c] = equals <+> c
add_bars (c:cs) = equals <+> sep (c : map (char '|' <+>) cs)
ppr_bangty (ty, str) = ppr_str str <> pprParendIfaceType ty
ppr_str MarkedStrict = char '!'
ppr_str MarkedUnboxed = ptext SLIT("!!")
ppr_str NotMarkedStrict = empty
showDecl exts want_name (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
ifFDs = fds, ifSigs = sigs})
= hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars
<+> pprFundeps fds <+> opt_where)
2 (vcat (ppr_trim show_op sigs))
where
opt_where | null sigs = empty
| otherwise = ptext SLIT("where")
show_op (IfaceClassOp op dm ty)
| want_name clas || want_name op
= Just (ppr_bndr op <+> dcolon <+> showIfaceType exts ty)
| otherwise
= Nothing
showIfaceType :: Bool -> IfaceType -> SDoc
showIfaceType True ty = pprIfaceType ty -- -fglasgow-exts: print with the foralls
showIfaceType False ty = ppr ty -- otherwise, print without the foralls
ppr_trim :: (a -> Maybe SDoc) -> [a] -> [SDoc]
ppr_trim show xs
= snd (foldr go (False, []) xs)
where
go x (eliding, so_far)
| Just doc <- show x = (False, doc : so_far)
| otherwise = if eliding then (True, so_far)
else (True, ptext SLIT("...") : so_far)
ppr_bndr :: OccName -> SDoc
-- Wrap operators in ()
ppr_bndr occ = parenSymOcc occ (ppr occ)
| fix == GHC.defaultFixity = empty
| otherwise = ppr fix <+> ppr (GHC.getName thing)
-----------------------------------------------------------------------------
-- Commands
......@@ -974,16 +872,29 @@ browseModule m exports_only = do
(as,bs) <- io (GHC.getContext s)
io (if exports_only then GHC.setContext s [] [prelude_mod,modl]
else GHC.setContext s [modl] [])
unqual <- io (GHC.getPrintUnqual s)
io (GHC.setContext s as bs)
things <- io (GHC.browseModule s modl exports_only)
unqual <- io (GHC.getPrintUnqual s)
mb_mod_info <- io $ GHC.getModuleInfo s modl
case mb_mod_info of
Nothing -> throwDyn (CmdLineError ("unknown module: " ++ m))
Just mod_info -> do
let names
| exports_only = GHC.modInfoExports mod_info
| otherwise = fromMaybe [] (GHC.modInfoTopLevelScope mod_info)
dflags <- getDynFlags
let exts = dopt Opt_GlasgowExts dflags
io (putStrLn (showSDocForUser unqual (
vcat (map (showDecl exts (const True)) things)
)))
filtered = filterOutChildren names
things <- io $ mapM (GHC.lookupName s) filtered
dflags <- getDynFlags
let exts = dopt Opt_GlasgowExts dflags
io (putStrLn (showSDocForUser unqual (
vcat (map (pprTyThing exts) (catMaybes things))
)))
-- ToDo: modInfoInstances currently throws an exception for
-- package modules. When it works, we can do this:
-- $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
-----------------------------------------------------------------------------
-- Setting the module context
......
......@@ -65,13 +65,12 @@ module GHC (
setContext, getContext,
getNamesInScope,
moduleIsInterpreted,
getInfo, GetInfoResult,
getInfo,
exprType,
typeKind,
parseName,
RunResult(..),
runStmt,
browseModule,
showModule,
compileExpr, HValue,
lookupName,
......@@ -83,34 +82,47 @@ module GHC (
Module, mkModule, pprModule,
-- ** Names
Name, nameModule,
Name,
nameModule, nameParent_maybe, pprParenSymName, nameSrcLoc,
NamedThing(..),
-- ** Identifiers
Id, idType,
isImplicitId, isDeadBinder,
isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
isRecordSelector,
isPrimOpId, isFCallId,
isPrimOpId, isFCallId, isClassOpId_maybe,
isDataConWorkId, idDataCon,
isBottomingId, isDictonaryId,
recordSelectorFieldLabel,
-- ** Type constructors
TyCon,
tyConTyVars, tyConDataCons,
isClassTyCon, isSynTyCon, isNewTyCon,
getSynTyConDefn,
-- ** Data constructors
DataCon,
dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
dataConIsInfix, isVanillaDataCon,
dataConStrictMarks,
StrictnessMark(..), isMarkedStrict,
-- ** Classes
Class,
classSCTheta, classTvsFds,
classMethods, classSCTheta, classTvsFds,
pprFundeps,
-- ** Instances
Instance,
Instance,
instanceDFunId, pprInstance,
-- ** Types and Kinds
Type, dropForAlls,
Type, dropForAlls, splitForAllTys, funResultTy, pprParendType,
Kind,
PredType,
ThetaType, pprThetaArrow,
-- ** Entities
TyThing(..),
......@@ -118,6 +130,15 @@ module GHC (
-- ** Syntax
module HsSyn, -- ToDo: remove extraneous bits
-- ** Fixities
FixityDirection(..),
defaultFixity, maxPrecedence,
negateFixity,
compareFixity,
-- ** Source locations
SrcLoc, pprDefnLoc,
-- * Exceptions
GhcException(..), showGhcException,
......@@ -129,8 +150,7 @@ module GHC (
{-
ToDo:
* inline bits of HscMain here to simplify layering: hscGetInfo,
hscTcExpr, hscStmt.
* inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
* we need to expose DynFlags, so should parseDynamicFlags really be
part of this interface?
* what StaticFlags should we expose, if any?
......@@ -141,17 +161,15 @@ module GHC (
#ifdef GHCI
import qualified Linker
import Linker ( HValue, extendLinkEnv )
import TcRnDriver ( getModuleContents, tcRnLookupRdrName,
getModuleExports )
import TcRnDriver ( tcRnLookupRdrName, tcRnGetInfo,
tcRnLookupName, getModuleExports )
import RdrName ( plusGlobalRdrEnv, Provenance(..),
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
emptyGlobalRdrEnv, mkGlobalRdrEnv )
import HscMain ( hscGetInfo, GetInfoResult, hscParseIdentifier,
hscStmt, hscTcExpr, hscKcType )
import HscMain ( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
import Type ( tidyType )
import VarEnv ( emptyTidyEnv )
import GHC.Exts ( unsafeCoerce# )
import IfaceSyn ( IfaceDecl )
#endif
import Packages ( initPackages, isHomeModule )
......@@ -159,19 +177,27 @@ import NameSet ( NameSet, nameSetToList, elemNameSet )
import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName,
globalRdrEnvElts )
import HsSyn
import Type ( Kind, Type, dropForAlls )
import Type ( Kind, Type, dropForAlls, PredType, ThetaType,
pprThetaArrow, pprParendType, splitForAllTys,
funResultTy )
import Id ( Id, idType, isImplicitId, isDeadBinder,
isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
isRecordSelector,
isPrimOpId, isFCallId,
isRecordSelector, recordSelectorFieldLabel,
isPrimOpId, isFCallId, isClassOpId_maybe,
isDataConWorkId, idDataCon,
isBottomingId )
import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon )
import Class ( Class, classSCTheta, classTvsFds )
import DataCon ( DataCon )
import Name ( Name, nameModule )
import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
tyConTyVars, tyConDataCons, getSynTyConDefn )
import Class ( Class, classSCTheta, classTvsFds, classMethods )
import FunDeps ( pprFundeps )
import DataCon ( DataCon, dataConWrapId, dataConSig, dataConTyCon,
dataConFieldLabels, dataConStrictMarks,
dataConIsInfix, isVanillaDataCon )
import Name ( Name, nameModule, NamedThing(..), nameParent_maybe,
nameSrcLoc )
import OccName ( parenSymOcc )
import NameEnv ( nameEnvElts )
import InstEnv ( Instance )
import InstEnv ( Instance, instanceDFunId, pprInstance )
import SrcLoc
import DriverPipeline
import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
......@@ -195,7 +221,7 @@ import Util
import StringBuffer ( StringBuffer, hGetStringBuffer )
import Outputable
import SysTools ( cleanTempFilesExcept )
import BasicTypes ( SuccessFlag(..), succeeded, failed )
import BasicTypes
import TcType ( tcSplitSigmaTy, isDictTy )
import FastString ( mkFastString )
......@@ -1794,9 +1820,8 @@ moduleIsInterpreted s modl = withSession s $ \h ->
_not_a_home_module -> return False
-- | Looks up an identifier in the current interactive context (for :info)
{-# DEPRECATED getInfo "we should be using parseName/lookupName instead" #-}
getInfo :: Session -> String -> IO [GetInfoResult]
getInfo s id = withSession s $ \hsc_env -> hscGetInfo hsc_env id
getInfo :: Session -> Name -> IO (Maybe (TyThing,Fixity,[Instance]))
getInfo s name = withSession s $ \hsc_env -> tcRnGetInfo hsc_env name
-- | Returns all names in scope in the current interactive context
getNamesInScope :: Session -> IO [Name]
......@@ -1820,12 +1845,17 @@ parseName s str = withSession s $ \hsc_env -> do
-- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
-- entity known to GHC, including 'Name's defined using 'runStmt'.
lookupName :: Session -> Name -> IO (Maybe TyThing)
lookupName s name = withSession s $ \hsc_env -> do
case lookupTypeEnv (ic_type_env (hsc_IC hsc_env)) name of
Just tt -> return (Just tt)
Nothing -> do
eps <- readIORef (hsc_EPS hsc_env)
return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
lookupName s name = withSession s $ \hsc_env -> tcRnLookupName hsc_env name
-- -----------------------------------------------------------------------------
-- Misc exported utils
dataConType :: DataCon -> Type
dataConType dc = idType (dataConWrapId dc)
-- | print a 'NamedThing', adding parentheses if the name is an operator.
pprParenSymName :: NamedThing a => a -> SDoc
pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
-- -----------------------------------------------------------------------------
-- Getting the type of an expression
......@@ -1948,18 +1978,6 @@ foreign import "rts_evalStableIO" {- safe -}
-- more informative than the C type!
-}
-- ---------------------------------------------------------------------------
-- cmBrowseModule: get all the TyThings defined in a module
{-# DEPRECATED browseModule "we should be using getModuleInfo instead" #-}
browseModule :: Session -> Module -> Bool -> IO [IfaceDecl]
browseModule s modl exports_only = withSession s $ \hsc_env -> do
mb_decls <- getModuleContents hsc_env modl exports_only
case mb_decls of
Nothing -> return [] -- An error of some kind
Just ds -> return ds
-----------------------------------------------------------------------------
-- show a module and it's source/object filenames
......
......@@ -12,7 +12,6 @@ module HscMain (
hscParseIdentifier,
#ifdef GHCI
hscStmt, hscTcExpr, hscKcType,
hscGetInfo, GetInfoResult,
compileExpr,
#endif
) where
......@@ -28,7 +27,7 @@ import Linker ( HValue, linkExpr )
import CoreTidy ( tidyExpr )
import CorePrep ( corePrepExpr )
import Flattening ( flattenExpr )
import TcRnDriver ( tcRnStmt, tcRnExpr, tcRnGetInfo, GetInfoResult, tcRnType )
import TcRnDriver ( tcRnStmt, tcRnExpr, tcRnType )
import Type ( Type )
import PrelNames ( iNTERACTIVE )
import Kind ( Kind )
......@@ -713,34 +712,6 @@ hscParseThing parser dflags str
}}
\end{code}
%************************************************************************
%* *
\subsection{Getting information about an identifer}
%* *
%************************************************************************
\begin{code}
#ifdef GHCI
hscGetInfo -- like hscStmt, but deals with a single identifier
:: HscEnv
-> String -- The identifier
-> IO [GetInfoResult]
hscGetInfo hsc_env str
= do maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
case maybe_rdr_name of {
Nothing -> return [];
Just (L _ rdr_name) -> do
maybe_tc_result <- tcRnGetInfo hsc_env (hsc_IC hsc_env) rdr_name
case maybe_tc_result of
Nothing -> return []
Just things -> return things
}
#endif
\end{code}
%************************************************************************
%* *
Desugar, simplify, convert to bytecode, and link an expression
......
-----------------------------------------------------------------------------
--
-- Pretty-printing TyThings
--
-- (c) The GHC Team 2005
--
-----------------------------------------------------------------------------
module PprTyThing (
pprTyThing,
pprTyThingInContext,
pprTyThingLoc,
pprTyThingInContextLoc,
) where
#include "HsVersions.h"
import qualified GHC
import GHC ( TyThing(..), SrcLoc )
import Outputable
-- -----------------------------------------------------------------------------
-- Pretty-printing entities that we get from the GHC API
-- This should be a good source of sample code for using the GHC API to
-- inspect source code entities.
-- | Pretty-prints a 'TyThing' with its defining location.
pprTyThingLoc :: Bool -> TyThing -> SDoc
pprTyThingLoc exts tyThing
= showWithLoc loc (pprTyThing exts tyThing)
where loc = GHC.nameSrcLoc (GHC.getName tyThing)
-- | Pretty-prints a 'TyThing'.
pprTyThing :: Bool -> TyThing -> SDoc
pprTyThing exts (AnId id) = pprId exts id
pprTyThing exts (ADataCon dataCon) = pprDataConSig exts dataCon
pprTyThing exts (ATyCon tyCon) = pprTyCon exts tyCon
pprTyThing exts (AClass cls) = pprClass exts cls
-- | Like 'pprTyThingInContext', but adds the defining location.
pprTyThingInContextLoc :: Bool -> TyThing -> SDoc
pprTyThingInContextLoc exts tyThing
= showWithLoc loc (pprTyThingInContext exts tyThing)
where loc = GHC.nameSrcLoc (GHC.getName tyThing)
-- | Pretty-prints a 'TyThing' in context: that is, if the entity
-- is a data constructor, record selector, or class method, then
-- the entity's parent declaration is pretty-printed with irrelevant
-- parts omitted.
pprTyThingInContext :: Bool -> TyThing -> SDoc
pprTyThingInContext exts (AnId id) = pprIdInContext exts id
pprTyThingInContext exts (ADataCon dataCon) = pprDataCon exts dataCon
pprTyThingInContext exts (ATyCon tyCon) = pprTyCon exts tyCon
pprTyThingInContext exts (AClass cls) = pprClass exts cls
pprTyConHdr exts tyCon =
ptext keyword <+> ppr_bndr tyCon <+> hsep (map ppr vars)
where
vars = GHC.tyConTyVars tyCon
keyword | GHC.isSynTyCon tyCon = SLIT("type")
| GHC.isNewTyCon tyCon = SLIT("newtype")
| otherwise = SLIT("data")
pprDataConSig exts dataCon =
ppr_bndr dataCon <+> dcolon <+> pprType exts (GHC.dataConType dataCon)
pprClassHdr exts cls =
let (tyVars, funDeps) = GHC.classTvsFds cls
in ptext SLIT("class") <+>
GHC.pprThetaArrow (GHC.classSCTheta cls) <+>
ppr_bndr cls <+>
hsep (map ppr tyVars) <+>
GHC.pprFundeps funDeps
pprIdInContext exts id
| GHC.isRecordSelector id = pprRecordSelector exts id
| Just cls <- GHC.isClassOpId_maybe id = pprClassOneMethod exts cls id
| otherwise = pprId exts id
pprRecordSelector exts id
= pprAlgTyCon exts tyCon show_con show_label
where
(tyCon,label) = GHC.recordSelectorFieldLabel id
show_con dataCon = label `elem` GHC.dataConFieldLabels dataCon
show_label label' = label == label'
pprId exts id
= hang (ppr_bndr id <+> dcolon) 2
(pprType exts (GHC.idType id))
pprType True ty = ppr ty
pprType False ty = ppr (GHC.dropForAlls ty)
pprTyCon exts tyCon
| GHC.isSynTyCon tyCon
= let (_,rhs_type) = GHC.getSynTyConDefn tyCon
in hang (pprTyConHdr exts tyCon <+> equals) 2 (pprType exts rhs_type)
| otherwise
= pprAlgTyCon exts tyCon (const True) (const True)