diff options
40 files changed, 224 insertions, 246 deletions
diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs index 963bf0e2c0..d6c948edac 100644 --- a/compiler/GHC/Hs/Lit.hs +++ b/compiler/GHC/Hs/Lit.hs @@ -23,7 +23,8 @@ import GhcPrelude import {-# SOURCE #-} GHC.Hs.Expr( HsExpr, pprExpr ) import BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit, - negateFractionalLit,SourceText(..),pprWithSourceText ) + negateFractionalLit,SourceText(..),pprWithSourceText, + PprPrec(..), topPrec ) import Type import Outputable import FastString diff --git a/compiler/basicTypes/PatSyn.hs b/compiler/basicTypes/PatSyn.hs index 14a05b3258..dddcb51319 100644 --- a/compiler/basicTypes/PatSyn.hs +++ b/compiler/basicTypes/PatSyn.hs @@ -27,6 +27,7 @@ module PatSyn ( import GhcPrelude import Type +import TyCoPpr import Name import Outputable import Unique diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 16b34f33dc..56921ac434 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -46,12 +46,12 @@ import PprCore import ErrUtils import Coercion import SrcLoc -import Kind import Type import RepType import TyCoRep -- checks validity of types/coercions import TyCoSubst import TyCoFVs +import TyCoPpr ( pprTyVar ) import TyCon import CoAxiom import BasicTypes diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs index 5fe033b862..c959fc1c4e 100644 --- a/compiler/coreSyn/PprCore.hs +++ b/compiler/coreSyn/PprCore.hs @@ -27,7 +27,7 @@ import IdInfo import Demand import DataCon import TyCon -import Type +import TyCoPpr import Coercion import DynFlags import BasicTypes diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index cfb799e05f..d0409ffd71 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -49,6 +49,7 @@ import MkId import Module import ConLike import DataCon +import TyCoPpr( pprWithTYPE ) import TysWiredIn import PrelNames import BasicTypes diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 7e9171adc9..a33edcd2ea 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -536,7 +536,6 @@ Library InstEnv TyCon CoAxiom - Kind Type TyCoRep TyCoFVs diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index b7b0d95217..fb60c21f9d 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -38,12 +38,12 @@ import PrimOp import CoreFVs import Type import RepType -import Kind ( isLiftedTypeKind ) import DataCon import TyCon import Util import VarSet import TysPrim +import TyCoPpr ( pprType ) import ErrUtils import Unique import FastString diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 09e7c1a3a8..37355a1329 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -63,7 +63,7 @@ import GhcPrelude import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon , liftedRepDataConTyCon, tupleTyConName ) -import {-# SOURCE #-} TyCoRep ( isRuntimeRepTy ) +import {-# SOURCE #-} Type ( isRuntimeRepTy ) import DynFlags import TyCon hiding ( pprPromotionQuote ) @@ -964,7 +964,7 @@ defaultRuntimeRepVars ty = go False emptyFsEnv ty go in_kind _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars - | in_kind && TyCoRep.isRuntimeRepTy (tyVarKind tv) + | in_kind && Type.isRuntimeRepTy (tyVarKind tv) = IfaceTyConApp liftedRep IA_Nil | otherwise = ty diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index c4d370cca0..265cef390b 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -39,7 +39,8 @@ import PrelNames ( pluginTyConName, frontendPluginTyConName ) import HscTypes import GHCi.RemoteTypes ( HValue ) -import Type ( Type, eqType, mkTyConTy, pprTyThingCategory ) +import Type ( Type, eqType, mkTyConTy ) +import TyCoPpr ( pprTyThingCategory ) import TyCon ( TyCon ) import Name ( Name, nameModule_maybe ) import Id ( idType ) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index d35adf8f4f..53c7680302 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -321,6 +321,7 @@ import TcType import Id import TysPrim ( alphaTyVars ) import TyCon +import TyCoPpr ( pprForAll ) import Class import DataCon import Name hiding ( varName ) diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index b1ed2b2059..4e49b6c661 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -21,15 +21,14 @@ module PprTyThing ( import GhcPrelude -import Type ( ArgFlag(..), TyThing(..), mkTyVarBinders, pprUserForAll ) +import Type ( Type, ArgFlag(..), TyThing(..), mkTyVarBinders, tidyOpenType ) import IfaceSyn ( ShowSub(..), ShowHowMuch(..), AltPpr(..) , showToHeader, pprIfaceDecl ) import CoAxiom ( coAxiomTyCon ) import HscTypes( tyThingParent_maybe ) import MkIface ( tyThingToIfaceDecl ) -import Type ( tidyOpenType ) import FamInstEnv( FamInst(..), FamFlavor(..) ) -import Type( Type, pprTypeApp, pprSigmaType ) +import TyCoPpr ( pprUserForAll, pprTypeApp, pprSigmaType ) import Name import VarEnv( emptyTidyEnv ) import Outputable diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index af2bf8fba2..5fea8646a4 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -70,7 +70,6 @@ import BasicTypes -- compiler/types import Type ( funTyCon ) -import Kind ( Kind ) import Class ( FunDep ) -- compiler/parser diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index bb7de4e3dd..8d1083a547 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -32,6 +32,7 @@ module RnNames ( import GhcPrelude import DynFlags +import TyCoPpr import GHC.Hs import TcEnv import RnEnv diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index eb57720d9e..5073bbff99 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -46,6 +46,7 @@ import DynFlags import CoreSyn import qualified CoreSubst import PprCore +import TyCoPpr ( pprParendType ) import CoreFVs import CoreUtils import CoreArity diff --git a/compiler/typecheck/Constraint.hs b/compiler/typecheck/Constraint.hs index b518acfc46..700c024a0d 100644 --- a/compiler/typecheck/Constraint.hs +++ b/compiler/typecheck/Constraint.hs @@ -92,6 +92,7 @@ import TcOrigin import CoreSyn +import TyCoPpr import OccName import FV import VarSet diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index c91b991ea8..213064d599 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -34,9 +34,9 @@ import Util import RdrName import DataCon ( dataConName ) import Maybes -import Type import TyCoRep import TyCoFVs +import TyCoPpr ( pprWithExplicitKindsWhen ) import TcMType import Name import Panic diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs index 809e42883a..30c848a7d5 100644 --- a/compiler/typecheck/FunDeps.hs +++ b/compiler/typecheck/FunDeps.hs @@ -33,6 +33,7 @@ import InstEnv import VarSet import VarEnv import TyCoFVs +import TyCoPpr( pprWithExplicitKindsWhen ) import FV import Outputable import ErrUtils( Validity(..), allValid ) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index cab0e596c5..4489482459 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -54,6 +54,7 @@ import FunDeps import TcMType import Type import TyCoRep +import TyCoPpr ( debugPprType ) import TcType import HscTypes import Class( Class ) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 11232e624e..a6c44d0c45 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -35,6 +35,7 @@ import Inst import FamInstEnv import TcHsType import TyCoRep +import TyCoPpr ( pprTyVars ) import RnNames( extendGlobalRdrEnvRn ) import RnBinds diff --git a/compiler/typecheck/TcDerivInfer.hs b/compiler/typecheck/TcDerivInfer.hs index 3187122828..97dffcd1cf 100644 --- a/compiler/typecheck/TcDerivInfer.hs +++ b/compiler/typecheck/TcDerivInfer.hs @@ -36,6 +36,7 @@ import Constraint import Predicate import TcType import TyCon +import TyCoPpr (pprTyVars) import Type import TcSimplify import TcValidity (validDerivPred) diff --git a/compiler/typecheck/TcDerivUtils.hs b/compiler/typecheck/TcDerivUtils.hs index 8defda4128..9005f738a4 100644 --- a/compiler/typecheck/TcDerivUtils.hs +++ b/compiler/typecheck/TcDerivUtils.hs @@ -49,6 +49,7 @@ import TcRnMonad import TcType import THNames (liftClassKey) import TyCon +import TyCoPpr (pprSourceTyCon) import Type import Util import VarSet diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 62117bc756..ffc054ee0a 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -25,6 +25,7 @@ import TcOrigin import RnUnbound ( unknownNameSuggestions ) import Type import TyCoRep +import TyCoPpr ( pprTyVars, pprWithExplicitKindsWhen, pprSourceTyCon, pprWithTYPE ) import Unify ( tcMatchTys ) import Module import FamInst diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 3c827fba59..b7a6779325 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -58,6 +58,7 @@ import NameSet import RdrName import TyCon import TyCoRep +import TyCoPpr import TyCoSubst (substTyWithInScope) import Type import TcEvidence diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 5cc2f897bb..fed20bf810 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -13,6 +13,7 @@ module TcFlatten( import GhcPrelude import TcRnTypes +import TyCoPpr ( pprTyVar ) import Constraint import Predicate import TcType diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 601433b99d..e8b67bbc89 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -59,6 +59,7 @@ import TcType import TcMType import TcEnv ( tcLookupGlobalOnly ) import TcEvidence +import TyCoPpr ( pprTyVar ) import TysPrim import TyCon import TysWiredIn diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 82cc6e2002..4ed472386c 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -83,6 +83,7 @@ import TcIface import TcSimplify import TcHsSyn import TyCoRep +import TyCoPpr import TcErrors ( reportAllUnsolved ) import TcType import Inst ( tcInstInvisibleTyBinders, tcInstInvisibleTyBinder ) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index d64a911550..bb6f2b4dc2 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -94,6 +94,7 @@ module TcMType ( import GhcPrelude import TyCoRep +import TyCoPpr import TcType import Type import TyCon diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 39e6dcd3dd..6d68cd5904 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -33,7 +33,7 @@ import RdrName import TcEnv import TcMType import TcValidity( arityErr ) -import Type ( pprTyVars ) +import TyCoPpr ( pprTyVars ) import TcType import TcUnify import TcHsType diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 2d925641b7..59f9b45617 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -140,7 +140,6 @@ import qualified ClsInst as TcM( matchGlobalInst, ClsInstResult(..) ) import qualified TcEnv as TcM ( checkWellStaged, tcGetDefaultTys, tcLookupClass, tcLookupId, topIdLvl ) import ClsInst( InstanceWhat(..), safeOverlap, instanceReturnsDictCon ) -import Kind import TcType import DynFlags import Type diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 80e220d385..9a81e35e06 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -50,6 +50,7 @@ import Coercion import TcOrigin import Type import TyCoRep -- for checkValidRoles +import TyCoPpr( pprTyVars, pprWithExplicitKindsWhen ) import Class import CoAxiom import TyCon diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index e81e3e8edb..1537859d1b 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -192,11 +192,10 @@ module TcType ( -- friends: import GhcPrelude -import Kind import TyCoRep import TyCoSubst ( mkTvSubst, substTyWithCoVars ) import TyCoFVs -import TyCoPpr ( pprParendTheta ) +import TyCoPpr import Class import Var import ForeignCall diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 819cc0c2ee..44842e43ae 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -42,6 +42,7 @@ import GhcPrelude import GHC.Hs import TyCoRep +import TyCoPpr( debugPprType ) import TcMType import TcRnMonad import TcType diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index b882f88828..f02cb887cf 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -29,6 +29,7 @@ import TcSimplify ( simplifyAmbiguityCheck ) import ClsInst ( matchGlobalInst, ClsInstResult(..), InstanceWhat(..), AssocInstInfo(..) ) import TyCoFVs import TyCoRep +import TyCoPpr import TcType hiding ( sizeType, sizeTypes ) import TysWiredIn ( heqTyConName, eqTyConName, coercibleTyConName ) import PrelNames diff --git a/compiler/types/Kind.hs b/compiler/types/Kind.hs deleted file mode 100644 index f59d23e1dc..0000000000 --- a/compiler/types/Kind.hs +++ /dev/null @@ -1,97 +0,0 @@ --- (c) The University of Glasgow 2006-2012 - -{-# LANGUAGE CPP #-} -module Kind ( - -- * Main data type - Kind, - - -- ** Predicates on Kinds - isLiftedTypeKind, isUnliftedTypeKind, - isConstraintKindCon, - - classifiesTypeWithValues, - isKindLevPoly - ) where - -#include "HsVersions.h" - -import GhcPrelude - -import {-# SOURCE #-} Type ( coreView ) - -import TyCoRep -import TyCon -import PrelNames - -import Outputable -import Util -import Data.Maybe( isJust ) - -{- -************************************************************************ -* * - Functions over Kinds -* * -************************************************************************ - -Note [Kind Constraint and kind Type] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The kind Constraint is the kind of classes and other type constraints. -The special thing about types of kind Constraint is that - * They are displayed with double arrow: - f :: Ord a => a -> a - * They are implicitly instantiated at call sites; so the type inference - engine inserts an extra argument of type (Ord a) at every call site - to f. - -However, once type inference is over, there is *no* distinction between -Constraint and Type. Indeed we can have coercions between the two. Consider - class C a where - op :: a -> a -For this single-method class we may generate a newtype, which in turn -generates an axiom witnessing - C a ~ (a -> a) -so on the left we have Constraint, and on the right we have Type. -See #7451. - -Bottom line: although 'Type' and 'Constraint' are distinct TyCons, with -distinct uniques, they are treated as equal at all times except -during type inference. --} - -isConstraintKindCon :: TyCon -> Bool -isConstraintKindCon tc = tyConUnique tc == constraintKindTyConKey - --- | Tests whether the given kind (which should look like @TYPE x@) --- is something other than a constructor tree (that is, constructors at every node). --- E.g. True of TYPE k, TYPE (F Int) --- False of TYPE 'LiftedRep -isKindLevPoly :: Kind -> Bool -isKindLevPoly k = ASSERT2( isLiftedTypeKind k || _is_type, ppr k ) - -- the isLiftedTypeKind check is necessary b/c of Constraint - go k - where - go ty | Just ty' <- coreView ty = go ty' - go TyVarTy{} = True - go AppTy{} = True -- it can't be a TyConApp - go (TyConApp tc tys) = isFamilyTyCon tc || any go tys - go ForAllTy{} = True - go (FunTy _ t1 t2) = go t1 || go t2 - go LitTy{} = False - go CastTy{} = True - go CoercionTy{} = True - - _is_type = classifiesTypeWithValues k - ------------------------------------------ --- Subkinding --- The tc variants are used during type-checking, where ConstraintKind --- is distinct from all other kinds --- After type-checking (in core), Constraint and liftedTypeKind are --- indistinguishable - --- | Does this classify a type allowed to have values? Responds True to things --- like *, #, TYPE Lifted, TYPE v, Constraint. -classifiesTypeWithValues :: Kind -> Bool --- ^ True of any sub-kind of OpenTypeKind -classifiesTypeWithValues k = isJust (kindRep_maybe k) diff --git a/compiler/types/TyCoPpr.hs b/compiler/types/TyCoPpr.hs index 1dfde74dd2..e46b299cc5 100644 --- a/compiler/types/TyCoPpr.hs +++ b/compiler/types/TyCoPpr.hs @@ -1,7 +1,10 @@ -- | Pretty-printing types and coercions. module TyCoPpr ( - -- * Pretty-printing + -- * Precedence + PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen, + + -- * Pretty-printing types pprType, pprParendType, pprPrecType, pprPrecTypeX, pprTypeApp, pprTCvBndr, pprTCvBndrs, pprSigmaType, @@ -9,12 +12,17 @@ module TyCoPpr pprTyVar, pprTyVars, pprThetaArrowTy, pprClassPred, pprKind, pprParendKind, pprTyLit, - PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen, pprDataCons, pprWithExplicitKindsWhen, + pprWithTYPE, pprSourceTyCon, + + -- * Pretty-printing coercions pprCo, pprParendCo, debugPprType, + + -- * Pretty-printing 'TyThing's + pprTyThingCategory, pprShortTyThing, ) where import GhcPrelude @@ -25,6 +33,8 @@ import {-# SOURCE #-} DataCon( dataConFullSig , dataConUserTyVarBinders , DataCon ) +import {-# SOURCE #-} Type( isLiftedTypeKind ) + import TyCon import TyCoRep import TyCoTidy @@ -37,7 +47,8 @@ import IfaceType import VarSet import VarEnv -import DynFlags ( gopt_set, GeneralFlag(Opt_PrintExplicitKinds) ) +import DynFlags ( gopt_set, + GeneralFlag(Opt_PrintExplicitKinds, Opt_PrintExplicitRuntimeReps) ) import Outputable import BasicTypes ( PprPrec(..), topPrec, sigPrec, opPrec , funPrec, appPrec, maybeParen ) @@ -305,3 +316,22 @@ pprWithExplicitKindsWhen b = updSDocDynFlags $ \dflags -> if b then gopt_set dflags Opt_PrintExplicitKinds else dflags + +-- | This variant preserves any use of TYPE in a type, effectively +-- locally setting -fprint-explicit-runtime-reps. +pprWithTYPE :: Type -> SDoc +pprWithTYPE ty = updSDocDynFlags (flip gopt_set Opt_PrintExplicitRuntimeReps) $ + ppr ty + +-- | Pretty prints a 'TyCon', using the family instance in case of a +-- representation tycon. For example: +-- +-- > data T [a] = ... +-- +-- In that case we want to print @T [a]@, where @T@ is the family 'TyCon' +pprSourceTyCon :: TyCon -> SDoc +pprSourceTyCon tycon + | Just (fam_tc, tys) <- tyConFamInst_maybe tycon + = ppr $ fam_tc `TyConApp` tys -- can't be FunTyCon + | otherwise + = ppr tycon diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 065efcd417..be2f74c731 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -14,8 +14,6 @@ Note [The Type-related module hierarchy] TyCoSubst imports TyCoRep, TyCoFVs, TyCoPpr TyCoTidy imports TyCoRep, TyCoFVs TysPrim imports TyCoRep ( including mkTyConTy ) - Kind imports TysPrim ( mainly for primitive kinds ) - Type imports Kind Coercion imports Type -} @@ -52,12 +50,6 @@ module TyCoRep ( mkForAllTy, mkForAllTys, mkPiTy, mkPiTys, - kindRep_maybe, kindRep, - isLiftedTypeKind, isUnliftedTypeKind, - isLiftedRuntimeRep, isUnliftedRuntimeRep, - isRuntimeRepTy, isRuntimeRepVar, - sameVis, - -- * Functions over binders TyCoBinder(..), TyCoVarBinder, TyBinder, binderVar, binderVars, binderType, binderArgFlag, @@ -77,7 +69,6 @@ module TyCoRep ( import GhcPrelude -import {-# SOURCE #-} Type( coreView ) import {-# SOURCE #-} TyCoPpr ( pprType, pprCo, pprTyLit ) -- Transitively pulls in a LOT of stuff, better to break the loop @@ -94,7 +85,6 @@ import CoAxiom -- others import BasicTypes ( LeftOrRight(..), pickLR ) -import PrelNames import Outputable import FastString import Util @@ -961,83 +951,6 @@ mkTyConTy :: TyCon -> Type mkTyConTy tycon = TyConApp tycon [] {- -Some basic functions, put here to break loops eg with the pretty printer --} - --- | Extract the RuntimeRep classifier of a type from its kind. For example, --- @kindRep * = LiftedRep@; Panics if this is not possible. --- Treats * and Constraint as the same -kindRep :: HasDebugCallStack => Kind -> Type -kindRep k = case kindRep_maybe k of - Just r -> r - Nothing -> pprPanic "kindRep" (ppr k) - --- | Given a kind (TYPE rr), extract its RuntimeRep classifier rr. --- For example, @kindRep_maybe * = Just LiftedRep@ --- Returns 'Nothing' if the kind is not of form (TYPE rr) --- Treats * and Constraint as the same -kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type -kindRep_maybe kind - | Just kind' <- coreView kind = kindRep_maybe kind' - | TyConApp tc [arg] <- kind - , tc `hasKey` tYPETyConKey = Just arg - | otherwise = Nothing - --- | This version considers Constraint to be the same as *. Returns True --- if the argument is equivalent to Type/Constraint and False otherwise. --- See Note [Kind Constraint and kind Type] -isLiftedTypeKind :: Kind -> Bool -isLiftedTypeKind kind - = case kindRep_maybe kind of - Just rep -> isLiftedRuntimeRep rep - Nothing -> False - --- | Returns True if the kind classifies unlifted types and False otherwise. --- Note that this returns False for levity-polymorphic kinds, which may --- be specialized to a kind that classifies unlifted types. -isUnliftedTypeKind :: Kind -> Bool -isUnliftedTypeKind kind - = case kindRep_maybe kind of - Just rep -> isUnliftedRuntimeRep rep - Nothing -> False - -isLiftedRuntimeRep :: Type -> Bool --- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep --- False of type variables (a :: RuntimeRep) --- and of other reps e.g. (IntRep :: RuntimeRep) -isLiftedRuntimeRep rep - | Just rep' <- coreView rep = isLiftedRuntimeRep rep' - | TyConApp rr_tc args <- rep - , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True - | otherwise = False - -isUnliftedRuntimeRep :: Type -> Bool --- True of definitely-unlifted RuntimeReps --- False of (LiftedRep :: RuntimeRep) --- and of variables (a :: RuntimeRep) -isUnliftedRuntimeRep rep - | Just rep' <- coreView rep = isUnliftedRuntimeRep rep' - | TyConApp rr_tc _ <- rep -- NB: args might be non-empty - -- e.g. TupleRep [r1, .., rn] - = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey) - -- Avoid searching all the unlifted RuntimeRep type cons - -- In the RuntimeRep data type, only LiftedRep is lifted - -- But be careful of type families (F tys) :: RuntimeRep - | otherwise {- Variables, applications -} - = False - --- | Is this the type 'RuntimeRep'? -isRuntimeRepTy :: Type -> Bool -isRuntimeRepTy ty | Just ty' <- coreView ty = isRuntimeRepTy ty' -isRuntimeRepTy (TyConApp tc args) - | tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True -isRuntimeRepTy _ = False - --- | Is a tyvar of type 'RuntimeRep'? -isRuntimeRepVar :: TyVar -> Bool -isRuntimeRepVar = isRuntimeRepTy . tyVarKind - -{- %************************************************************************ %* * Coercions diff --git a/compiler/types/TyCoRep.hs-boot b/compiler/types/TyCoRep.hs-boot index 8f1d0ad526..0050dcd26b 100644 --- a/compiler/types/TyCoRep.hs-boot +++ b/compiler/types/TyCoRep.hs-boot @@ -1,7 +1,5 @@ module TyCoRep where -import GhcPrelude - import Data.Data ( Data ) import {-# SOURCE #-} Var( Var, ArgFlag, AnonArgFlag ) @@ -22,6 +20,4 @@ type MCoercionN = MCoercion mkFunTy :: AnonArgFlag -> Type -> Type -> Type mkForAllTy :: Var -> ArgFlag -> Type -> Type -isRuntimeRepTy :: Type -> Bool - instance Data Type -- To support Data instances in CoAxiom diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 44d18aff9a..f91b7caf88 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -79,7 +79,7 @@ module Type ( modifyJoinResTy, setJoinResTy, - -- Analyzing types + -- ** Analyzing types TyCoMapper(..), mapType, mapCoercion, -- (Newtypes) @@ -112,8 +112,11 @@ module Type ( isValidJoinPointType, tyConAppNeedsKindSig, - -- (Lifting and boxity) - isLiftedType_maybe, isUnliftedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType, + -- *** Levity and boxity + isLiftedType_maybe, + isLiftedTypeKind, isUnliftedTypeKind, + isLiftedRuntimeRep, isUnliftedRuntimeRep, + isUnliftedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType, isAlgType, isDataFamilyAppType, isPrimitiveType, isStrictType, isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy, @@ -194,17 +197,6 @@ module Type ( substVarBndr, substVarBndrs, cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar, - -- * Pretty-printing - pprType, pprParendType, pprPrecType, - pprTypeApp, pprTyThingCategory, pprShortTyThing, - pprTCvBndr, pprTCvBndrs, pprForAll, pprUserForAll, - pprSigmaType, pprWithExplicitKindsWhen, - pprTheta, pprThetaArrowTy, pprClassPred, - pprKind, pprParendKind, pprSourceTyCon, - PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen, - pprTyVar, pprTyVars, debugPprType, - pprWithTYPE, - -- * Tidying type related things up for printing tidyType, tidyTypes, tidyOpenType, tidyOpenTypes, @@ -214,7 +206,12 @@ module Type ( tidyTyCoVarOcc, tidyTopType, tidyKind, - tidyTyCoVarBinder, tidyTyCoVarBinders + tidyTyCoVarBinder, tidyTyCoVarBinders, + + -- * Kinds + isConstraintKindCon, + classifiesTypeWithValues, + isKindLevPoly ) where #include "HsVersions.h" @@ -226,11 +223,9 @@ import BasicTypes -- We import the representation and primitive functions from TyCoRep. -- Many things are reexported, but not the representation! -import Kind import TyCoRep import TyCoSubst import TyCoTidy -import TyCoPpr import TyCoFVs -- friends: @@ -260,7 +255,6 @@ import FV import Outputable import FastString import Pair -import DynFlags ( gopt_set, GeneralFlag(Opt_PrintExplicitRuntimeReps) ) import ListSetOps import Unique ( nonDetCmpUnique ) @@ -479,6 +473,81 @@ expandTypeSynonyms ty -- order of a coercion) go_cobndr subst = substForAllCoBndrUsing False (go_co subst) subst + +-- | Extract the RuntimeRep classifier of a type from its kind. For example, +-- @kindRep * = LiftedRep@; Panics if this is not possible. +-- Treats * and Constraint as the same +kindRep :: HasDebugCallStack => Kind -> Type +kindRep k = case kindRep_maybe k of + Just r -> r + Nothing -> pprPanic "kindRep" (ppr k) + +-- | Given a kind (TYPE rr), extract its RuntimeRep classifier rr. +-- For example, @kindRep_maybe * = Just LiftedRep@ +-- Returns 'Nothing' if the kind is not of form (TYPE rr) +-- Treats * and Constraint as the same +kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type +kindRep_maybe kind + | Just kind' <- coreView kind = kindRep_maybe kind' + | TyConApp tc [arg] <- kind + , tc `hasKey` tYPETyConKey = Just arg + | otherwise = Nothing + +-- | This version considers Constraint to be the same as *. Returns True +-- if the argument is equivalent to Type/Constraint and False otherwise. +-- See Note [Kind Constraint and kind Type] +isLiftedTypeKind :: Kind -> Bool +isLiftedTypeKind kind + = case kindRep_maybe kind of + Just rep -> isLiftedRuntimeRep rep + Nothing -> False + +isLiftedRuntimeRep :: Type -> Bool +-- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep +-- False of type variables (a :: RuntimeRep) +-- and of other reps e.g. (IntRep :: RuntimeRep) +isLiftedRuntimeRep rep + | Just rep' <- coreView rep = isLiftedRuntimeRep rep' + | TyConApp rr_tc args <- rep + , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True + | otherwise = False + +-- | Returns True if the kind classifies unlifted types and False otherwise. +-- Note that this returns False for levity-polymorphic kinds, which may +-- be specialized to a kind that classifies unlifted types. +isUnliftedTypeKind :: Kind -> Bool +isUnliftedTypeKind kind + = case kindRep_maybe kind of + Just rep -> isUnliftedRuntimeRep rep + Nothing -> False + +isUnliftedRuntimeRep :: Type -> Bool +-- True of definitely-unlifted RuntimeReps +-- False of (LiftedRep :: RuntimeRep) +-- and of variables (a :: RuntimeRep) +isUnliftedRuntimeRep rep + | Just rep' <- coreView rep = isUnliftedRuntimeRep rep' + | TyConApp rr_tc _ <- rep -- NB: args might be non-empty + -- e.g. TupleRep [r1, .., rn] + = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey) + -- Avoid searching all the unlifted RuntimeRep type cons + -- In the RuntimeRep data type, only LiftedRep is lifted + -- But be careful of type families (F tys) :: RuntimeRep + | otherwise {- Variables, applications -} + = False + +-- | Is this the type 'RuntimeRep'? +isRuntimeRepTy :: Type -> Bool +isRuntimeRepTy ty | Just ty' <- coreView ty = isRuntimeRepTy ty' +isRuntimeRepTy (TyConApp tc args) + | tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True +isRuntimeRepTy _ = False + +-- | Is a tyvar of type 'RuntimeRep'? +isRuntimeRepVar :: TyVar -> Bool +isRuntimeRepVar = isRuntimeRepTy . tyVarKind + + {- ************************************************************************ * * @@ -1845,19 +1914,6 @@ coAxNthLHS :: CoAxiom br -> Int -> Type coAxNthLHS ax ind = mkTyConApp (coAxiomTyCon ax) (coAxBranchLHS (coAxiomNthBranch ax ind)) --- | Pretty prints a 'TyCon', using the family instance in case of a --- representation tycon. For example: --- --- > data T [a] = ... --- --- In that case we want to print @T [a]@, where @T@ is the family 'TyCon' -pprSourceTyCon :: TyCon -> SDoc -pprSourceTyCon tycon - | Just (fam_tc, tys) <- tyConFamInst_maybe tycon - = ppr $ fam_tc `TyConApp` tys -- can't be FunTyCon - | otherwise - = ppr tycon - isFamFreeTy :: Type -> Bool isFamFreeTy ty | Just ty' <- coreView ty = isFamFreeTy ty' isFamFreeTy (TyVarTy _) = True @@ -2804,6 +2860,74 @@ setJoinResTy :: Int -- Number of binders to skip setJoinResTy ar new_res_ty ty = modifyJoinResTy ar (const new_res_ty) ty +{- +************************************************************************ +* * + Functions over Kinds +* * +************************************************************************ + +Note [Kind Constraint and kind Type] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The kind Constraint is the kind of classes and other type constraints. +The special thing about types of kind Constraint is that + * They are displayed with double arrow: + f :: Ord a => a -> a + * They are implicitly instantiated at call sites; so the type inference + engine inserts an extra argument of type (Ord a) at every call site + to f. + +However, once type inference is over, there is *no* distinction between +Constraint and Type. Indeed we can have coercions between the two. Consider + class C a where + op :: a -> a +For this single-method class we may generate a newtype, which in turn +generates an axiom witnessing + C a ~ (a -> a) +so on the left we have Constraint, and on the right we have Type. +See #7451. + +Bottom line: although 'Type' and 'Constraint' are distinct TyCons, with +distinct uniques, they are treated as equal at all times except +during type inference. +-} + +isConstraintKindCon :: TyCon -> Bool +isConstraintKindCon tc = tyConUnique tc == constraintKindTyConKey + +-- | Tests whether the given kind (which should look like @TYPE x@) +-- is something other than a constructor tree (that is, constructors at every node). +-- E.g. True of TYPE k, TYPE (F Int) +-- False of TYPE 'LiftedRep +isKindLevPoly :: Kind -> Bool +isKindLevPoly k = ASSERT2( isLiftedTypeKind k || _is_type, ppr k ) + -- the isLiftedTypeKind check is necessary b/c of Constraint + go k + where + go ty | Just ty' <- coreView ty = go ty' + go TyVarTy{} = True + go AppTy{} = True -- it can't be a TyConApp + go (TyConApp tc tys) = isFamilyTyCon tc || any go tys + go ForAllTy{} = True + go (FunTy _ t1 t2) = go t1 || go t2 + go LitTy{} = False + go CastTy{} = True + go CoercionTy{} = True + + _is_type = classifiesTypeWithValues k + +----------------------------------------- +-- Subkinding +-- The tc variants are used during type-checking, where ConstraintKind +-- is distinct from all other kinds +-- After type-checking (in core), Constraint and liftedTypeKind are +-- indistinguishable + +-- | Does this classify a type allowed to have values? Responds True to things +-- like *, #, TYPE Lifted, TYPE v, Constraint. +classifiesTypeWithValues :: Kind -> Bool +-- ^ True of any sub-kind of OpenTypeKind +classifiesTypeWithValues k = isJust (kindRep_maybe k) {- %************************************************************************ @@ -2816,13 +2940,6 @@ Most pretty-printing is either in TyCoRep or IfaceType. -} --- | This variant preserves any use of TYPE in a type, effectively --- locally setting -fprint-explicit-runtime-reps. -pprWithTYPE :: Type -> SDoc -pprWithTYPE ty = updSDocDynFlags (flip gopt_set Opt_PrintExplicitRuntimeReps) $ - ppr ty - - -- | Does a 'TyCon' (that is applied to some number of arguments) need to be -- ascribed with an explicit kind signature to resolve ambiguity if rendered as -- a source-syntax type? diff --git a/compiler/types/Type.hs-boot b/compiler/types/Type.hs-boot index 446c9d989d..16c6bfe07b 100644 --- a/compiler/types/Type.hs-boot +++ b/compiler/types/Type.hs-boot @@ -18,6 +18,8 @@ eqType :: Type -> Type -> Bool coreView :: Type -> Maybe Type tcView :: Type -> Maybe Type +isRuntimeRepTy :: Type -> Bool +isLiftedTypeKind :: Type -> Bool splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type]) diff --git a/utils/haddock b/utils/haddock -Subproject b34ca2554a3440f092f585bb7fc1e9d4b2ca861 +Subproject e3c045f9265e39c1a77aa003bf35785e1871a9d |