diff options
Diffstat (limited to 'compiler/types')
| -rw-r--r-- | compiler/types/Kind.hs | 97 | ||||
| -rw-r--r-- | compiler/types/TyCoPpr.hs | 36 | ||||
| -rw-r--r-- | compiler/types/TyCoRep.hs | 87 | ||||
| -rw-r--r-- | compiler/types/TyCoRep.hs-boot | 4 | ||||
| -rw-r--r-- | compiler/types/Type.hs | 193 | ||||
| -rw-r--r-- | compiler/types/Type.hs-boot | 2 |
6 files changed, 190 insertions, 229 deletions
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]) |