Commit 57573e7e authored by simonpj's avatar simonpj

[project @ 2003-10-30 16:01:49 by simonpj]

This commit does a long-overdue tidy-up

* Remove PprType (gets rid of one more bunch of hi-boot files)

* Put pretty-printing for types in TypeRep

* Make a specialised pretty-printer for Types, rather than
  converting to IfaceTypes and printing those
parent fc6b0049
__interface DataCon 1 0 where
__export DataCon DataCon isExistentialDataCon ;
__export DataCon DataCon isExistentialDataCon dataConName ;
1 data DataCon ;
1 isExistentialDataCon :: DataCon -> PrelBase.Bool ;
1 dataConName :: DataCon -> Name.Name ;
module DataCon where
data DataCon
dataConName :: DataCon -> Name.Name
isExistentialDataCon :: DataCon -> GHC.Base.Bool
......@@ -25,12 +25,11 @@ module DataCon (
#include "HsVersions.h"
import {-# SOURCE #-} Subst( substTyWith )
import {-# SOURCE #-} PprType( pprType )
import Type ( Type, ThetaType,
mkForAllTys, mkFunTys, mkTyConApp,
mkTyVarTys, splitTyConApp_maybe,
mkPredTys, isStrictPred
mkPredTys, isStrictPred, pprType
)
import TyCon ( TyCon, tyConDataCons, tyConDataCons, isProductTyCon,
isTupleTyCon, isUnboxedTupleTyCon )
......
......@@ -311,13 +311,13 @@ pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
pprExternal sty name uniq mod occ mb_p is_wired
| codeStyle sty = ppr (moduleName mod) <> char '_' <> pprOccName occ
| debugStyle sty = sep [ppr (moduleName mod) <> dot <> pprOccName occ,
hsep [text "{-",
if is_wired then ptext SLIT("(w)") else empty,
pprUnique uniq,
case mb_p of
Nothing -> empty
Just n -> brackets (ppr n),
text "-}"]]
hsep [text "{-"
, if is_wired then ptext SLIT("(w)") else empty
, pprUnique uniq
-- (overkill) , case mb_p of
-- Nothing -> empty
-- Just n -> brackets (ppr n)
, text "-}"]]
| unqualStyle sty name = pprOccName occ
| otherwise = ppr (moduleName mod) <> dot <> pprOccName occ
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.60 2003/05/14 09:13:53 simonmar Exp $
% $Id: CgClosure.lhs,v 1.61 2003/10/30 16:01:52 simonpj Exp $
%
\section[CgClosure]{Code generation for closures}
......@@ -39,7 +39,6 @@ import Name ( Name, isInternalName )
import Module ( Module, pprModule )
import ListSetOps ( minusList )
import PrimRep ( PrimRep(..), getPrimRepSize )
import PprType ( showTypeCategory )
import Util ( isIn, splitAtList )
import CmdLineOpts ( opt_SccProfilingOn )
import Outputable
......@@ -47,6 +46,12 @@ import FastString
import Name ( nameOccName )
import OccName ( occNameFS )
-- Turgid imports for showTypeCategory
import PrelNames
import TcType ( Type, isDictTy, tcSplitTyConApp_maybe, tcSplitFunTy_maybe )
import TyCon ( isPrimTyCon, isTupleTyCon, isEnumerationTyCon, maybeTyConSingleCon )
import Maybe
\end{code}
%********************************************************
......@@ -674,3 +679,55 @@ chooseDynCostCentres ccs args fvs body
in
(use_cc, blame_cc)
\end{code}
\begin{code}
showTypeCategory :: Type -> Char
{-
{C,I,F,D} char, int, float, double
T tuple
S other single-constructor type
{c,i,f,d} unboxed ditto
t *unpacked* tuple
s *unpacked" single-cons...
v void#
a primitive array
E enumeration type
+ dictionary, unless it's a ...
L List
> function
M other (multi-constructor) data-con type
. other type
- reserved for others to mark as "uninteresting"
-}
showTypeCategory ty
= if isDictTy ty
then '+'
else
case tcSplitTyConApp_maybe ty of
Nothing -> if isJust (tcSplitFunTy_maybe ty)
then '>'
else '.'
Just (tycon, _) ->
let utc = getUnique tycon in
if utc == charDataConKey then 'C'
else if utc == intDataConKey then 'I'
else if utc == floatDataConKey then 'F'
else if utc == doubleDataConKey then 'D'
else if utc == smallIntegerDataConKey ||
utc == largeIntegerDataConKey then 'J'
else if utc == charPrimTyConKey then 'c'
else if (utc == intPrimTyConKey || utc == wordPrimTyConKey
|| utc == addrPrimTyConKey) then 'i'
else if utc == floatPrimTyConKey then 'f'
else if utc == doublePrimTyConKey then 'd'
else if isPrimTyCon tycon {- array, we hope -} then 'A' -- Bogus
else if isEnumerationTyCon tycon then 'E'
else if isTupleTyCon tycon then 'T'
else if isJust (maybeTyConSingleCon tycon) then 'S'
else if utc == listTyConKey then 'L'
else 'M' -- oh, well...
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: ClosureInfo.lhs,v 1.59 2003/10/09 11:58:46 simonpj Exp $
% $Id: ClosureInfo.lhs,v 1.60 2003/10/30 16:01:52 simonpj Exp $
%
\section[ClosureInfo]{Data structures which describe closures}
......@@ -72,14 +72,14 @@ import Id ( Id, idType, idArity, idName, idPrimRep )
import DataCon ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
isNullaryDataCon, dataConName
)
import Name ( Name, nameUnique, getOccName, getName )
import Name ( Name, nameUnique, getOccName, getName, getOccString )
import OccName ( occNameUserString )
import PprType ( getTyDescription )
import PrimRep
import SMRep -- all of it
import Type ( isUnLiftedType, Type, repType, splitTyConApp_maybe )
import TcType ( tcSplitSigmaTy )
import TyCon ( isFunTyCon )
import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel )
import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, ipNameName )
import Util ( mapAccumL, listLengthCmp, lengthIs )
import FastString
import Outputable
......@@ -1056,6 +1056,27 @@ closureTypeDescr (ClosureInfo { closureType = ty })
= getTyDescription ty
closureTypeDescr (ConInfo { closureCon = data_con })
= occNameUserString (getOccName (dataConTyCon data_con))
getTyDescription :: Type -> String
getTyDescription ty
= case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
case tau_ty of
TyVarTy _ -> "*"
AppTy fun _ -> getTyDescription fun
FunTy _ res -> '-' : '>' : fun_result res
NewTcApp tycon _ -> getOccString tycon
TyConApp tycon _ -> getOccString tycon
NoteTy (FTVNote _) ty -> getTyDescription ty
NoteTy (SynNote ty1) _ -> getTyDescription ty1
PredTy sty -> getPredTyDescription sty
ForAllTy _ ty -> getTyDescription ty
}
where
fun_result (FunTy _ res) = '>' : fun_result res
fun_result other = getTyDescription other
getPredTyDescription (ClassP cl tys) = getOccString cl
getPredTyDescription (IParam ip ty) = getOccString (ipNameName ip)
\end{code}
%************************************************************************
......
......@@ -27,7 +27,7 @@ import Id ( Id, idType, isDataConWorkId_maybe, idLBVarInfo, idArity,
globalIdDetails, isGlobalId, isExportedId,
isSpecPragmaId, idNewDemandInfo
)
import Var ( isTyVar )
import Var ( TyVar, isTyVar, tyVarKind )
import IdInfo ( IdInfo, megaSeqIdInfo,
arityInfo, ppArityInfo,
specInfo, pprNewStrictness,
......@@ -40,7 +40,7 @@ import IdInfo ( IdInfo, megaSeqIdInfo,
)
import DataCon ( dataConTyCon )
import TyCon ( tupleTyConBoxity, isTupleTyCon )
import PprType ( pprParendType, pprType, pprTyVarBndr )
import Type ( pprParendType, pprType, pprParendKind )
import BasicTypes ( tupleParens )
import Util ( lengthIs )
import Outputable
......@@ -294,6 +294,17 @@ pprTypedBinder binder
-- printing interfaces, because we get \ x::(a->b) y::(c->d) -> ...
-- [Jun 2002: interfaces are now binary, so this doesn't matter]
pprTyVarBndr :: TyVar -> SDoc
pprTyVarBndr tyvar
= getPprStyle $ \ sty ->
if debugStyle sty then
hsep [ppr tyvar, dcolon, pprParendKind kind]
-- See comments with ppDcolon in PprCore.lhs
else
ppr tyvar
where
kind = tyVarKind tyvar
-- pprIdBndr does *not* print the type
-- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
pprIdBndr id = ppr id <+>
......
......@@ -178,7 +178,7 @@ unboxArg arg
-- Data types with a single constructor, which has a single, primitive-typed arg
-- This deals with Int, Float etc; also Ptr, ForeignPtr
| is_product_type && data_con_arity == 1
= ASSERT2(isUnLiftedType data_con_arg_ty1, crudePprType arg_ty)
= ASSERT2(isUnLiftedType data_con_arg_ty1, pprType arg_ty)
-- Typechecker ensures this
newSysLocalDs arg_ty `thenDs` \ case_bndr ->
newSysLocalDs data_con_arg_ty1 `thenDs` \ prim_arg ->
......
......@@ -34,7 +34,7 @@ import DataCon ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
import TyCon ( tyConFamilySize, isDataTyCon, tyConDataCons,
isUnboxedTupleTyCon )
import Class ( Class, classTyCon )
import Type ( Type, repType, splitFunTys, dropForAlls )
import Type ( Type, repType, splitFunTys, dropForAlls, pprType )
import Util
import DataCon ( dataConRepArity )
import Var ( isTyVar )
......@@ -48,7 +48,6 @@ import ErrUtils ( showPass, dumpIfSet_dyn )
import Unique ( mkPseudoUnique3 )
import FastString ( FastString(..), unpackFS )
import Panic ( GhcException(..) )
import PprType ( pprType )
import SMRep ( arrWordsHdrSize, arrPtrsHdrSize, StgWord )
import Bitmap ( intsToReverseBitmap, mkBitmap )
import OrdList
......
......@@ -17,8 +17,7 @@ import HsTypes ( HsType, PostTcType, SyntaxName, placeHolderType )
import HsImpExp ( isOperator, pprHsVar )
-- others:
import PprType ( pprParendType )
import Type ( Type )
import Type ( Type, pprParendType )
import Var ( TyVar, Id )
import Name ( Name )
import DataCon ( DataCon )
......
......@@ -26,10 +26,9 @@ module HsTypes (
#include "HsVersions.h"
import TcType ( Type, Kind, liftedTypeKind, eqKind )
import TypeRep ( Type )
import Type ( {- instance Outputable Kind -}, pprParendKind, pprKind )
import Name ( Name, mkInternalName )
import OccName ( mkVarOcc )
import PprType ( {- instance Outputable Kind -}, pprParendKind, pprKind )
import BasicTypes ( IPName, Boxity, tupleParens )
import PrelNames ( unboundKey )
import SrcLoc ( noSrcLoc )
......
......@@ -27,7 +27,7 @@ module IfaceType (
#include "HsVersions.h"
import Type ( openTypeKind, liftedTypeKind, unliftedTypeKind,
splitFunTy_maybe, eqKind )
splitFunTy_maybe, eqKind, pprType )
import TypeRep ( Type(..), TyNote(..), PredType(..), Kind, ThetaType )
import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
import Var ( isId, tyVarKind, idType )
......@@ -38,10 +38,6 @@ import Module ( ModuleName )
import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
import Outputable
import FastString
#ifdef DEBUG
import TypeRep( crudePprType )
#endif
\end{code}
......@@ -342,7 +338,7 @@ toIfaceKind k
| Just (arg,res) <- splitFunTy_maybe k
= IfaceFunKind (toIfaceKind arg) (toIfaceKind res)
#ifdef DEBUG
| otherwise = pprTrace "toIfaceKind" (crudePprType k) IfaceOpenTypeKind
| otherwise = pprTrace "toIfaceKind" (pprType k) IfaceOpenTypeKind
#endif
---------------------
......
......@@ -22,7 +22,7 @@ import BuildTyCl ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass )
import TcRnMonad
import Type ( Kind, openTypeKind, liftedTypeKind,
unliftedTypeKind, mkArrowKind, splitTyConApp,
mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType )
mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType, pprClassPred )
import TypeRep ( Type(..), PredType(..) )
import TyCon ( TyCon, tyConName )
import HscTypes ( ExternalPackageState(..), PackageInstEnv, PackageRuleBase,
......@@ -32,7 +32,6 @@ import HscTypes ( ExternalPackageState(..), PackageInstEnv, PackageRuleBase,
DeclPool, RulePool, Pool(..), Gated, addRuleToPool )
import InstEnv ( extendInstEnv )
import CoreSyn
import PprType ( pprClassPred )
import PprCore ( pprIdRules )
import Rules ( extendRuleBaseList )
import CoreUtils ( exprType )
......
......@@ -16,7 +16,7 @@ import TyCon ( TyCon, tyConPrimRep, isUnboxedTupleTyCon, tyConDataCons,
tyConTyVars, isDataTyCon, isAlgTyCon, tyConArity
)
import Type ( liftedTypeKind, openTypeKind, unliftedTypeKind,
isUnLiftedType, isTyVarTy, mkTyVarTy, predTypeRep,
isUnLiftedType, isTyVarTy, mkTyVarTy, predTypeRep, pprType,
splitForAllTys, splitFunTys, applyTy, applyTys, eqKind, tyVarsOfTypes
)
import TypeRep ( Type(..) )
......@@ -43,7 +43,6 @@ import Outputable
import Char ( ord )
import List ( partition, elem, insertBy,any )
import UniqSet
import PprType ( pprType ) -- Only called in debug messages
import TysPrim ( foreignObjPrimTyCon, weakPrimTyCon, byteArrayPrimTyCon, mutableByteArrayPrimTyCon )
......
......@@ -63,7 +63,8 @@ import TcType ( Type, TcType, TcThetaType, TcTyVarSet,
isClassPred, isTyVarClassPred, isLinearPred,
getClassPredTys, getClassPredTys_maybe, mkPredName,
isInheritablePred, isIPPred, matchTys,
tidyType, tidyTypes, tidyFreeTyVars, tcSplitSigmaTy
tidyType, tidyTypes, tidyFreeTyVars, tcSplitSigmaTy,
pprPred, pprParendType, pprThetaArrow, pprClassPred
)
import HscTypes ( ExternalPackageState(..) )
import CoreFVs ( idFreeTyVars )
......@@ -72,7 +73,6 @@ import Id ( Id, idName, idType, mkUserLocal, mkSysLocal, mkLocalId, setIdUnique
import PrelInfo ( isStandardClass, isNoDictClass )
import Name ( Name, mkMethodOcc, getOccName, getSrcLoc, isHomePackageName, isInternalName )
import NameSet ( addOneToNameSet )
import PprType ( pprPred, pprParendType, pprThetaArrow, pprClassPred )
import Subst ( substTy, substTyWith, substTheta, mkTyVarSubst )
import Literal ( inIntRange )
import Var ( TyVar )
......
......@@ -14,7 +14,6 @@ module TcClassDcl ( tcClassSigs, tcClassDecl2,
import HsSyn ( TyClDecl(..), Sig(..), MonoBinds(..), HsType(..),
HsExpr(..), HsLit(..), Pat(WildPat), HsTyVarBndr(..),
HsExplicitForAll(..),
mkSimpleMatch, andMonoBinds, andMonoBindList,
isPragSig, placeHolderType, mkExplicitHsForAllTy
)
......@@ -29,7 +28,8 @@ import TcHsSyn ( TcMonoBinds )
import Inst ( Inst, InstOrigin(..), instToId, newDicts, newMethod )
import TcEnv ( tcLookupClass, tcExtendLocalValEnv2, tcExtendTyVarEnv2,
InstInfo(..), pprInstInfo, simpleInstInfoTyCon, simpleInstInfoTy,
InstInfo(..), pprInstInfoDetails,
simpleInstInfoTyCon, simpleInstInfoTy,
InstBindings(..), newDFunName
)
import TcBinds ( tcMonoBinds, tcSpecSigs )
......@@ -535,29 +535,28 @@ mkDefMethRhs origin clas inst_tys sel_id loc NoDefMeth
wild_pats = [WildPat placeHolderType | ty <- arg_tys]
mkDefMethRhs origin clas inst_tys sel_id loc GenDefMeth
= -- A generic default method
-- If the method is defined generically, we can only do the job if the
= -- A generic default method
-- If the method is defined generically, we can only do the job if the
-- instance declaration is for a single-parameter type class with
-- a type constructor applied to type arguments in the instance decl
-- (checkTc, so False provokes the error)
ASSERT( isInstDecl origin ) -- We never get here from a class decl
checkTc (isJust maybe_tycon)
(badGenericInstance sel_id (notSimple inst_tys)) `thenM_`
checkTc (tyConHasGenerics tycon)
(badGenericInstance sel_id (notGeneric tycon)) `thenM_`
ioToTcRn (dumpIfSet opt_PprStyle_Debug "Generic RHS" stuff) `thenM_`
-- Rename it before returning it
rnExpr rhs `thenM` \ (rn_rhs, _) ->
returnM rn_rhs
ASSERT( isInstDecl origin ) -- We never get here from a class decl
do { checkTc (isJust maybe_tycon)
(badGenericInstance sel_id (notSimple inst_tys))
; checkTc (tyConHasGenerics tycon)
(badGenericInstance sel_id (notGeneric tycon))
; dflags <- getDOpts
; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
(vcat [ppr clas <+> ppr inst_tys,
nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
-- Rename it before returning it
; (rn_rhs, _) <- rnExpr rhs
; returnM rn_rhs }
where
rhs = mkGenericRhs sel_id clas_tyvar tycon
stuff = vcat [ppr clas <+> ppr inst_tys,
nest 4 (ppr sel_id <+> equals <+> ppr rhs)]
-- The tycon is only used in the generic case, and in that
-- case we require that the instance decl is for a single-parameter
-- type class with type variable arguments:
......@@ -629,7 +628,7 @@ getGenericInstances class_decls
-- Otherwise print it out
{ dflags <- getDOpts
; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
(vcat (map pprInstInfo gen_inst_info)))
(vcat (map pprInstInfoDetails gen_inst_info)))
; returnM gen_inst_info }}
get_generics decl@(ClassDecl {tcdName = class_name, tcdMeths = def_methods, tcdLoc = loc})
......@@ -670,7 +669,6 @@ get_generics decl@(ClassDecl {tcdName = class_name, tcdMeths = def_methods, tcdL
checkTc (null missing) (missingGenericInstances missing) `thenM_`
returnM inst_infos
where
generic_binds :: [(HsType Name, RenamedMonoBinds)]
generic_binds = getGenericBinds def_methods
......
......@@ -232,11 +232,7 @@ tcDeriving tycl_decls
where
ddump_deriving :: [InstInfo] -> RenamedHsBinds -> SDoc
ddump_deriving inst_infos extra_binds
= vcat (map ppr_info inst_infos) $$ ppr extra_binds
ppr_info inst_info = pprInstInfo inst_info $$
nest 4 (pprInstInfoDetails inst_info)
-- pprInstInfo doesn't print much: only the type
= vcat (map pprInstInfoDetails inst_infos) $$ ppr extra_binds
-----------------------------------------
deriveOrdinaryStuff [] -- Short cut
......
......@@ -572,8 +572,10 @@ data InstBindings
pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))]
pprInstInfoDetails (InstInfo { iBinds = VanillaInst b _ }) = ppr b
pprInstInfoDetails (InstInfo { iBinds = NewTypeDerived _}) = text "Derived from the representation type"
pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
where
details (VanillaInst b _) = ppr b
details (NewTypeDerived _) = text "Derived from the representation type"
simpleInstInfoTy :: InstInfo -> Type
simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
......
......@@ -43,9 +43,8 @@ import TcType ( Type, PredType(..), ThetaType, TyVarDetails(..),
mkForAllTys, mkFunTys, tcEqType, isPredTy,
mkSigmaTy, mkPredTy, mkGenTyConApp, mkTyConApp, mkAppTys,
liftedTypeKind, unliftedTypeKind, eqKind,
tcSplitFunTy_maybe, tcSplitForAllTys, tcSplitSigmaTy
)
import PprType ( pprKind, pprThetaArrow )
tcSplitFunTy_maybe, tcSplitForAllTys, tcSplitSigmaTy,
pprKind, pprThetaArrow )
import qualified Type ( splitFunTys )
import Inst ( Inst, InstOrigin(..), newMethod, instToId )
......
......@@ -23,8 +23,7 @@ import TcMType ( tcInstType, checkValidTheta, checkValidInstHead, instTypeErr,
checkAmbiguity, SourceTyCtxt(..) )
import TcType ( mkClassPred, tcSplitForAllTys, tyVarsOfType,
tcSplitSigmaTy, getClassPredTys, tcSplitPredTy_maybe, mkTyVarTys,
TyVarDetails(..), tcSplitDFunTy
)
TyVarDetails(..), tcSplitDFunTy, pprClassPred )
import Inst ( InstOrigin(..), tcInstClassOp, newDicts, instToId,
showLIE, tcExtendLocalInstEnv )
import TcDeriv ( tcDeriving )
......@@ -32,7 +31,6 @@ import TcEnv ( tcExtendGlobalValEnv, tcExtendTyVarEnv2,
InstInfo(..), InstBindings(..),
newDFunName, tcExtendLocalValEnv
)
import PprType ( pprClassPred )
import TcHsType ( kcHsSigType, tcHsKindedType )
import TcUnify ( checkSigTyVars )
import TcSimplify ( tcSimplifyCheck, tcSimplifyTop )
......
......@@ -61,9 +61,8 @@ import TcType ( TcType, TcThetaType, TcTauType, TcPredType,
liftedTypeKind, defaultKind, superKind,
superBoxity, liftedBoxity, typeKind,
tyVarsOfType, tyVarsOfTypes,
eqKind, isTypeKind,
)
import PprType ( pprThetaArrow )
eqKind, isTypeKind, pprThetaArrow,
pprPred, pprTheta, pprClassPred )
import Subst ( Subst, mkTopTyVarSubst, substTy )
import Class ( Class, classArity, className )
import TyCon ( TyCon, isSynTyCon, isUnboxedTupleTyCon,
......@@ -74,7 +73,6 @@ import Var ( TyVar, tyVarKind, tyVarName, isTyVar,
-- others:
import TcRnMonad -- TcType, amongst others
import FunDeps ( grow )
import PprType ( pprPred, pprTheta, pprClassPred )
import Name ( Name, setNameUnique, mkSystemTvNameEncoded )
import VarSet
import CmdLineOpts ( dopt, DynFlag(..) )
......
......@@ -637,6 +637,8 @@ tc_rn_src_decls ds
-- Rename the splice expression, and get its supporting decls
(rn_splice_expr, splice_fvs) <- addSrcLoc splice_loc $
rnExpr splice_expr ;
failIfErrsM ; -- Don't typecheck if renaming failed
-- Execute the splice
spliced_decls <- tcSpliceDecls rn_splice_expr ;
......
......@@ -32,8 +32,7 @@ import TcUnify ( unifyKind )
import TcType ( TcKind, ThetaType, TcType,
mkArrowKind, liftedTypeKind,
tcSplitSigmaTy, tcEqType )
import Type ( splitTyConApp_maybe )
import PprType ( pprThetaArrow, pprParendType )
import Type ( splitTyConApp_maybe, pprThetaArrow, pprParendType )
import FieldLabel ( fieldLabelName, fieldLabelType )
import Generics ( validGenericMethodType, canDoGenerics )
import Class ( Class, className, classTyCon, DefMeth(..), classBigSig )
......
......@@ -25,7 +25,7 @@ import RnHsSyn ( extractHsTyNames )
import Type ( predTypeRep )
import BuildTyCl ( newTyConRhs )
import HscTypes ( TyThing(..) )
import TyCon ( TyCon, ArgVrcs, tyConArity, tyConDataCons_maybe, tyConDataCons, tyConTyVars,
import TyCon ( TyCon, ArgVrcs, tyConArity, tyConDataCons, tyConTyVars,
getSynTyConDefn, isSynTyCon, isAlgTyCon, isHiBootTyCon,
tyConName, isNewTyCon, isProductTyCon, tyConArgVrcs )
import Class ( classTyCon )
......@@ -36,7 +36,6 @@ import Name ( Name, isTyVarName )
import NameEnv
import NameSet
import Digraph ( SCC(..), stronglyConnComp, stronglyConnCompR )
import Maybe ( isNothing )
import BasicTypes ( RecFlag(..) )
import Outputable
\end{code}
......
......@@ -102,14 +102,15 @@ module TcType (
tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars,
typeKind, eqKind,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta
) where
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
#include "HsVersions.h"
pprKind, pprParendKind,
pprType, pprParendType,
pprPred, pprTheta, pprThetaArrow, pprClassPred
) where
import {-# SOURCE #-} PprType( pprType )
-- PprType imports TcType so that it can print intelligently
#include "HsVersions.h"
-- friends:
import TypeRep ( Type(..), TyNote(..), funTyCon ) -- friend
......@@ -133,7 +134,10 @@ import Type ( -- Re-exports
tidyTyVarBndr, tidyOpenTyVar,
tidyOpenTyVars, eqKind,
hasMoreBoxityInfo, liftedBoxity,
superBoxity, typeKind, superKind, repType
superBoxity, typeKind, superKind, repType,
pprKind, pprParendKind,
pprType, pprParendType,
pprPred, pprTheta, pprThetaArrow, pprClassPred
)
import TyCon ( TyCon, isUnLiftedTyCon, tyConUnique )
import Class ( Class )
......
......@@ -43,8 +43,7 @@ import TcType ( TcKind, TcType, TcSigmaType, TcRhoType, TcTyVar, TcTauType,
isSkolemTyVar, isUserTyVar,
tidyOpenType, tidyOpenTypes, tidyOpenTyVar, tidyOpenTyVars,
eqKind, openTypeKind, liftedTypeKind, isTypeKind, mkArrowKind,
hasMoreBoxityInfo, allDistinctTyVars
)
hasMoreBoxityInfo, allDistinctTyVars, pprType )
import Inst ( newDicts, instToId, tcInstCall )
import TcMType ( getTcTyVar, putTcTyVar, tcInstType, newKindVar,
newTyVarTy, newTyVarTys, newOpenTypeKind,
......@@ -53,7 +52,6 @@ import TcSimplify ( tcSimplifyCheck )
import TysWiredIn ( listTyCon, parrTyCon, tupleTyCon )
import TcEnv ( tcGetGlobalTyVars, findGlobals )
import TyCon ( TyCon, tyConArity, isTupleTyCon, tupleTyConBoxity )
import PprType ( pprType )
import Id ( Id, mkSysLocal )
import Var ( Var, varName, tyVarKind )
import VarSet ( emptyVarSet, unitVarSet, unionVarSet, elemVarSet, varSetElems )
......
......@@ -21,7 +21,6 @@ import TcType ( Type, ThetaType, PredType(..),
predTyUnique, mkClassPred, tyVarsOfTypes, tyVarsOfPred,
unifyTyListsX, unifyExtendTysX, tcEqType
)
import PprType ( )
import VarSet
import VarEnv
import Outputable
......
_interface_ PprType 1
_exports_
PprType pprType pprPred;
_declarations_
1 pprType _:_ TypeRep.Type -> Outputable.SDoc ;;
1 pprPred _:_ Type.PredType -> Outputable.SDoc ;;
__interface PprType 1 0 where
__export PprType pprType pprPred ;
1 pprType :: TypeRep.Type -> Outputable.SDoc ;
1 pprPred :: Type.PredType -> Outputable.SDoc ;
module PprType where
pprType :: TypeRep.Type -> Outputable.SDoc
pprPred :: Type.PredType -> Outputable.SDoc
%
% (c) The AQUA Project, Glasgow University, 1996-1998
%
\section[PprType]{Printing Types, TyVars, Classes, TyCons}
\begin{code}
module PprType(
pprKind, pprParendKind,
pprType, pprParendType,
pprPred, pprTheta, pprThetaArrow, pprClassPred,
pprTyVarBndr, pprTyVarBndrs,
-- Junk
getTyDescription, showTypeCategory
) where
#include "HsVersions.h"
-- friends:
-- (PprType can see all the representations it's trying to print)
import TypeRep ( Type(..), TyNote(..), PredType(..), TyThing(..), Kind, superKind ) -- friend
import Type ( typeKind, eqKind )
import IfaceType ( toIfaceType, toIfacePred, pprParendIfaceType,
toIfaceKind, pprParendIfaceKind,
getIfaceExt )
import TcType ( ThetaType, PredType,
tcSplitSigmaTy, isDictTy,
tcSplitTyConApp_maybe, tcSplitFunTy_maybe