Commit 8fa4bf9a authored by Ben Gamari's avatar Ben Gamari 🐢

Type-indexed Typeable

This at long last realizes the ideas for type-indexed Typeable discussed in A
Reflection on Types (#11011). The general sketch of the project is described on
the Wiki (Typeable/BenGamari). The general idea is that we are adding a type
index to `TypeRep`,

    data TypeRep (a :: k)

This index allows the typechecker to reason about the type represented by the `TypeRep`.
This index representation mechanism is exposed as `Type.Reflection`, which also provides
a number of patterns for inspecting `TypeRep`s,

```lang=haskell
pattern TRFun :: forall k (fun :: k). ()
              => forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
                        (arg :: TYPE r1) (res :: TYPE r2).
                 (k ~ Type, fun ~~ (arg -> res))
              => TypeRep arg
              -> TypeRep res
              -> TypeRep fun

pattern TRApp :: forall k2 (t :: k2). ()
              => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b)
              => TypeRep a -> TypeRep b -> TypeRep t

-- | Pattern match on a type constructor.
pattern TRCon :: forall k (a :: k). TyCon -> TypeRep a

-- | Pattern match on a type constructor including its instantiated kind
-- variables.
pattern TRCon' :: forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
```

In addition, we give the user access to the kind of a `TypeRep` (#10343),

    typeRepKind :: TypeRep (a :: k) -> TypeRep k

Moreover, all of this plays nicely with 8.2's levity polymorphism, including the
newly levity polymorphic (->) type constructor.

Library changes
---------------

The primary change here is the introduction of a Type.Reflection module to base.
This module provides access to the new type-indexed TypeRep introduced in this
patch. We also continue to provide the unindexed Data.Typeable interface, which
is simply a type synonym for the existentially quantified SomeTypeRep,

    data SomeTypeRep where SomeTypeRep :: TypeRep a -> SomeTypeRep

Naturally, this change also touched Data.Dynamic, which can now export the
Dynamic data constructor. Moreover, I removed a blanket reexport of
Data.Typeable from Data.Dynamic (which itself doesn't even import Data.Typeable
now).

We also add a kind heterogeneous type equality type, (:~~:), to
Data.Type.Equality.

Implementation
--------------

The implementation strategy is described in Note [Grand plan for Typeable] in
TcTypeable. None of it was difficult, but it did exercise a number of parts of
the new levity polymorphism story which had not yet been exercised, which took
some sorting out.

The rough idea is that we augment the TyCon produced for each type constructor
with information about the constructor's kind (which we call a KindRep). This
allows us to reconstruct the monomorphic result kind of an particular
instantiation of a type constructor given its kind arguments.

Unfortunately all of this takes a fair amount of work to generate and send
through the compilation pipeline. In particular, the KindReps can unfortunately
get quite large. Moreover, the simplifier will float out various pieces of them,
resulting in numerous top-level bindings. Consequently we mark the KindRep
bindings as noinline, ensuring that the float-outs don't make it into the
interface file. This is important since there is generally little benefit to
inlining KindReps and they would otherwise strongly affect compiler performance.

Performance
-----------

Initially I was hoping to also clear up the remaining holes in Typeable's
coverage by adding support for both unboxed tuples (#12409) and unboxed sums
(#13276). While the former was fairly straightforward, the latter ended up being
quite difficult: while the implementation can support them easily, enabling this
support causes thousands of Typeable bindings to be emitted to the GHC.Types as
each arity-N sum tycon brings with it N promoted datacons, each of which has a
KindRep whose size which itself scales with N. Doing this was simply too
expensive to be practical; consequently I've disabled support for the time
being.

Even after disabling sums this change regresses compiler performance far more
than I would like. In particular there are several testcases in the testsuite
which consist mostly of types which regress by over 30% in compiler allocations.
These include (considering the "bytes allocated" metric),

 * T1969:  +10%
 * T10858: +23%
 * T3294:  +19%
 * T5631:  +41%
 * T6048:  +23%
 * T9675:  +20%
 * T9872a: +5.2%
 * T9872d: +12%
 * T9233:  +10%
 * T10370: +34%
 * T12425: +30%
 * T12234: +16%
 * 13035:  +17%
 * T4029:  +6.1%

I've spent quite some time chasing down the source of this regression and while
I was able to make som improvements, I think this approach of generating
Typeable bindings at time of type definition is doomed to give us unnecessarily
large compile-time overhead.

In the future I think we should consider moving some of all of the Typeable
binding generation logic back to the solver (where it was prior to
91c6b1f5). I've opened #13261 documenting this
proposal.
parent b207b536
......@@ -405,6 +405,9 @@ rnIfaceDecl d@IfaceId{} = do
IfDFunId -> rnIfaceNeverExported (ifName d)
_ | isDefaultMethodOcc (occName (ifName d))
-> rnIfaceNeverExported (ifName d)
-- Typeable bindings. See Note [Grand plan for Typeable].
_ | isTypeableBindOcc (occName (ifName d))
-> rnIfaceNeverExported (ifName d)
| otherwise -> rnIfaceGlobal (ifName d)
ty <- rnIfaceType (ifType d)
details <- rnIfaceIdDetails (ifIdDetails d)
......
......@@ -31,7 +31,7 @@ module MkId (
voidPrimId, voidArgId,
nullAddrId, seqId, lazyId, lazyIdKey, runRWId,
coercionTokenId, magicDictId, coerceId,
proxyHashId, noinlineIdName,
proxyHashId, noinlineId, noinlineIdName,
-- Re-export error Ids
module PrelRules
......
......@@ -57,7 +57,7 @@ module OccName (
isDerivedOccName,
mkDataConWrapperOcc, mkWorkerOcc,
mkMatcherOcc, mkBuilderOcc,
mkDefaultMethodOcc, isDefaultMethodOcc,
mkDefaultMethodOcc, isDefaultMethodOcc, isTypeableBindOcc,
mkNewTyCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkClassDataConOcc, mkDictOcc, mkIPOcc,
......@@ -601,6 +601,16 @@ isDefaultMethodOcc occ =
'$':'d':'m':_ -> True
_ -> False
-- | Is an 'OccName' one of a Typeable @TyCon@ or @Module@ binding?
-- This is needed as these bindings are renamed differently.
-- See Note [Grand plan for Typeable] in TcTypeable.
isTypeableBindOcc :: OccName -> Bool
isTypeableBindOcc occ =
case occNameString occ of
'$':'t':'c':_ -> True -- mkTyConRepOcc
'$':'t':'r':_ -> True -- Module binding
_ -> False
mkDataConWrapperOcc, mkWorkerOcc,
mkMatcherOcc, mkBuilderOcc,
mkDefaultMethodOcc,
......
......@@ -1031,7 +1031,7 @@ lintTyKind tyvar arg_ty
-- and then apply it to both boxed and unboxed types.
= do { arg_kind <- lintType arg_ty
; unless (arg_kind `eqType` tyvar_kind)
(addErrL (mkKindErrMsg tyvar arg_ty $$ (text "xx" <+> ppr arg_kind))) }
(addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) }
where
tyvar_kind = tyVarKind tyvar
......
......@@ -38,7 +38,6 @@ import CoreFVs
import Digraph
import PrelNames
import TysPrim ( mkProxyPrimTy )
import TyCon
import TcEvidence
import TcType
......@@ -1195,49 +1194,71 @@ dsEvTypeable :: Type -> EvTypeable -> DsM CoreExpr
-- This code is tightly coupled to the representation
-- of TypeRep, in base library Data.Typeable.Internals
dsEvTypeable ty ev
= do { tyCl <- dsLookupTyCon typeableClassName -- Typeable
= do { tyCl <- dsLookupTyCon typeableClassName -- Typeable
; let kind = typeKind ty
Just typeable_data_con
= tyConSingleDataCon_maybe tyCl -- "Data constructor"
-- for Typeable
= tyConSingleDataCon_maybe tyCl -- "Data constructor"
-- for Typeable
; rep_expr <- ds_ev_typeable ty ev
-- Build Core for (let r::TypeRep = rep in \proxy. rep)
-- See Note [Memoising typeOf]
; repName <- newSysLocalDs (exprType rep_expr)
; let proxyT = mkProxyPrimTy kind ty
method = bindNonRec repName rep_expr
$ mkLams [mkWildValBinder proxyT] (Var repName)
; rep_expr <- ds_ev_typeable ty ev -- :: TypeRep a
-- Package up the method as `Typeable` dictionary
; return $ mkConApp typeable_data_con [Type kind, Type ty, method] }
; return $ mkConApp typeable_data_con [Type kind, Type ty, rep_expr] }
type TypeRepExpr = CoreExpr
-- | Returns a @CoreExpr :: TypeRep ty@
ds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr
-- Returns a CoreExpr :: TypeRep ty
ds_ev_typeable ty (EvTypeableTyCon evs)
| Just (tc, ks) <- splitTyConApp_maybe ty
= do { ctr <- dsLookupGlobalId mkPolyTyConAppName
-- mkPolyTyConApp :: TyCon -> [KindRep] -> [TypeRep] -> TypeRep
; tyRepTc <- dsLookupTyCon typeRepTyConName -- TypeRep (the TyCon)
; let tyRepType = mkTyConApp tyRepTc [] -- TypeRep (the Type)
mkRep cRep kReps tReps
= mkApps (Var ctr) [ cRep
, mkListExpr tyRepType kReps
, mkListExpr tyRepType tReps ]
; tcRep <- tyConRep tc
; kReps <- zipWithM getRep evs ks
; return (mkRep tcRep kReps []) }
ds_ev_typeable ty (EvTypeableTyCon tc kind_ev)
= do { mkTrCon <- dsLookupGlobalId mkTrConName
-- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a
; someTypeRepTyCon <- dsLookupTyCon someTypeRepTyConName
; someTypeRepDataCon <- dsLookupDataCon someTypeRepDataConName
-- SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep
; tc_rep <- tyConRep tc -- :: TyCon
; let ks = tyConAppArgs ty
-- Construct a SomeTypeRep
toSomeTypeRep :: Type -> EvTerm -> DsM CoreExpr
toSomeTypeRep t ev = do
rep <- getRep ev t
return $ mkCoreConApps someTypeRepDataCon [Type (typeKind t), Type t, rep]
; kind_arg_reps <- sequence $ zipWith toSomeTypeRep ks kind_ev -- :: TypeRep t
; let -- :: [SomeTypeRep]
kind_args = mkListExpr (mkTyConTy someTypeRepTyCon) kind_arg_reps
-- Note that we use the kind of the type, not the TyCon from which it
-- is constructed since the latter may be kind polymorphic whereas the
-- former we know is not (we checked in the solver).
; return $ mkApps (Var mkTrCon) [ Type (typeKind ty)
, Type ty
, tc_rep
, kind_args ]
}
ds_ev_typeable ty (EvTypeableTyApp ev1 ev2)
| Just (t1,t2) <- splitAppTy_maybe ty
= do { e1 <- getRep ev1 t1
; e2 <- getRep ev2 t2
; ctr <- dsLookupGlobalId mkAppTyName
; return ( mkApps (Var ctr) [ e1, e2 ] ) }
; mkTrApp <- dsLookupGlobalId mkTrAppName
-- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
-- TypeRep a -> TypeRep b -> TypeRep (a b)
; let (k1, k2) = splitFunTy (typeKind t1)
; return $ mkApps (mkTyApps (Var mkTrApp) [ k1, k2, t1, t2 ])
[ e1, e2 ] }
ds_ev_typeable ty (EvTypeableTrFun ev1 ev2)
| Just (t1,t2) <- splitFunTy_maybe ty
= do { e1 <- getRep ev1 t1
; e2 <- getRep ev2 t2
; mkTrFun <- dsLookupGlobalId mkTrFunName
-- mkTrFun :: forall r1 r2 (a :: TYPE r1) (b :: TYPE r2).
-- TypeRep a -> TypeRep b -> TypeRep (a -> b)
; let r1 = getRuntimeRep "ds_ev_typeable" t1
r2 = getRuntimeRep "ds_ev_typeable" t2
; return $ mkApps (mkTyApps (Var mkTrFun) [r1, r2, t1, t2])
[ e1, e2 ]
}
ds_ev_typeable ty (EvTypeableTyLit ev)
= do { fun <- dsLookupGlobalId tr_fun
......@@ -1248,28 +1269,26 @@ ds_ev_typeable ty (EvTypeableTyLit ev)
ty_kind = typeKind ty
-- tr_fun is the Name of
-- typeNatTypeRep :: KnownNat a => Proxy# a -> TypeRep
-- of typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep
-- typeNatTypeRep :: KnownNat a => Proxy# a -> TypeRep a
-- of typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep a
tr_fun | ty_kind `eqType` typeNatKind = typeNatTypeRepName
| ty_kind `eqType` typeSymbolKind = typeSymbolTypeRepName
| otherwise = panic "dsEvTypeable: unknown type lit kind"
ds_ev_typeable ty ev
= pprPanic "dsEvTypeable" (ppr ty $$ ppr ev)
getRep :: EvTerm -> Type -- EvTerm for Typeable ty, and ty
-> DsM CoreExpr -- Return CoreExpr :: TypeRep (of ty)
-- namely (typeRep# dict proxy)
getRep :: EvTerm -- ^ EvTerm for @Typeable ty@
-> Type -- ^ The type @ty@
-> DsM TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@
-- namely @typeRep# dict@
-- Remember that
-- typeRep# :: forall k (a::k). Typeable k a -> Proxy k a -> TypeRep
-- typeRep# :: forall k (a::k). Typeable k a -> TypeRep a
getRep ev ty
= do { typeable_expr <- dsEvTerm ev
; typeRepId <- dsLookupGlobalId typeRepIdName
; let ty_args = [typeKind ty, ty]
; return (mkApps (mkTyApps (Var typeRepId) ty_args)
[ typeable_expr
, mkTyApps (Var proxyHashId) ty_args ]) }
; return (mkApps (mkTyApps (Var typeRepId) ty_args) [ typeable_expr ]) }
tyConRep :: TyCon -> DsM CoreExpr
-- Returns CoreExpr :: TyCon
......
......@@ -58,32 +58,57 @@ knownUniqueName u =
-- Anonymous sums
--
-- Sum arities start from 2. The encoding is a bit funny: we break up the
-- integral part into bitfields for the arity and alternative index (which is
-- taken to be 0xff in the case of the TyCon)
-- integral part into bitfields for the arity, an alternative index (which is
-- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a
-- tag (used to identify the sum's TypeRep binding).
--
-- This layout is chosen to remain compatible with the usual unique allocation
-- for wired-in data constructors described in Unique.hs
--
-- TyCon for sum of arity k:
-- 00000000 kkkkkkkk 11111111
-- 00000000 kkkkkkkk 11111100
-- TypeRep of TyCon for sum of arity k:
-- 00000000 kkkkkkkk 11111101
--
-- DataCon for sum of arity k and alternative n (zero-based):
-- 00000000 kkkkkkkk nnnnnnnn
-- 00000000 kkkkkkkk nnnnnn00
--
-- TypeRep for sum DataCon of arity k and alternative n (zero-based):
-- 00000000 kkkkkkkk nnnnnn10
mkSumTyConUnique :: Arity -> Unique
mkSumTyConUnique arity =
ASSERT(arity < 0xff)
mkUnique 'z' (arity `shiftL` 8 .|. 0xff)
mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)
mkSumDataConUnique :: ConTagZ -> Arity -> Unique
mkSumDataConUnique alt arity
| alt >= arity
= panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)
| otherwise
= mkUnique 'z' (arity `shiftL` 8 + alt) {- skip the tycon -}
= mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}
getUnboxedSumName :: Int -> Name
getUnboxedSumName n =
case n .&. 0xff of
0xff -> tyConName $ sumTyCon arity
alt -> dataConName $ sumDataCon (alt + 1) arity
where arity = n `shiftR` 8
getUnboxedSumName n
| n .&. 0xfc == 0xfc
= case tag of
0x0 -> tyConName $ sumTyCon arity
0x1 -> getRep $ sumTyCon arity
_ -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag)
| tag == 0x0
= dataConName $ sumDataCon (alt + 1) arity
| tag == 0x2
= getRep $ promoteDataCon $ sumDataCon (alt + 1) arity
| otherwise
= pprPanic "getUnboxedSumName" (ppr n)
where
arity = n `shiftR` 8
alt = (n .&. 0xff) `shiftR` 2
tag = 0x3 .&. n
getRep tycon =
fromMaybe (pprPanic "getUnboxedSumName" (ppr tycon))
$ tyConRepName_maybe tycon
-- Note [Uniques for tuple type and data constructors]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -224,9 +224,23 @@ basicKnownKeyNames
-- Typeable
typeableClassName,
typeRepTyConName,
someTypeRepTyConName,
someTypeRepDataConName,
kindRepTyConName,
kindRepTyConAppDataConName,
kindRepVarDataConName,
kindRepAppDataConName,
kindRepFunDataConName,
kindRepTYPEDataConName,
kindRepTypeLitSDataConName,
kindRepTypeLitDDataConName,
typeLitSortTyConName,
typeLitSymbolDataConName,
typeLitNatDataConName,
typeRepIdName,
mkPolyTyConAppName,
mkAppTyName,
mkTrConName,
mkTrAppName,
mkTrFunName,
typeSymbolTypeRepName, typeNatTypeRepName,
trGhcPrimModuleName,
......@@ -1200,11 +1214,40 @@ trNameDDataConName = dcQual gHC_TYPES (fsLit "TrNameD") trNam
trTyConTyConName = tcQual gHC_TYPES (fsLit "TyCon") trTyConTyConKey
trTyConDataConName = dcQual gHC_TYPES (fsLit "TyCon") trTyConDataConKey
kindRepTyConName
, kindRepTyConAppDataConName
, kindRepVarDataConName
, kindRepAppDataConName
, kindRepFunDataConName
, kindRepTYPEDataConName
, kindRepTypeLitSDataConName
, kindRepTypeLitDDataConName
:: Name
kindRepTyConName = tcQual gHC_TYPES (fsLit "KindRep") kindRepTyConKey
kindRepTyConAppDataConName = dcQual gHC_TYPES (fsLit "KindRepTyConApp") kindRepTyConAppDataConKey
kindRepVarDataConName = dcQual gHC_TYPES (fsLit "KindRepVar") kindRepVarDataConKey
kindRepAppDataConName = dcQual gHC_TYPES (fsLit "KindRepApp") kindRepAppDataConKey
kindRepFunDataConName = dcQual gHC_TYPES (fsLit "KindRepFun") kindRepFunDataConKey
kindRepTYPEDataConName = dcQual gHC_TYPES (fsLit "KindRepTYPE") kindRepTYPEDataConKey
kindRepTypeLitSDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitS") kindRepTypeLitSDataConKey
kindRepTypeLitDDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitD") kindRepTypeLitDDataConKey
typeLitSortTyConName
, typeLitSymbolDataConName
, typeLitNatDataConName
:: Name
typeLitSortTyConName = tcQual gHC_TYPES (fsLit "TypeLitSort") typeLitSortTyConKey
typeLitSymbolDataConName = dcQual gHC_TYPES (fsLit "TypeLitSymbol") typeLitSymbolDataConKey
typeLitNatDataConName = dcQual gHC_TYPES (fsLit "TypeLitNat") typeLitNatDataConKey
-- Class Typeable, and functions for constructing `Typeable` dictionaries
typeableClassName
, typeRepTyConName
, mkPolyTyConAppName
, mkAppTyName
, someTypeRepTyConName
, someTypeRepDataConName
, mkTrConName
, mkTrAppName
, mkTrFunName
, typeRepIdName
, typeNatTypeRepName
, typeSymbolTypeRepName
......@@ -1212,9 +1255,12 @@ typeableClassName
:: Name
typeableClassName = clsQual tYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey
typeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "TypeRep") typeRepTyConKey
someTypeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepTyConKey
someTypeRepDataConName = dcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepDataConKey
typeRepIdName = varQual tYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey
mkPolyTyConAppName = varQual tYPEABLE_INTERNAL (fsLit "mkPolyTyConApp") mkPolyTyConAppKey
mkAppTyName = varQual tYPEABLE_INTERNAL (fsLit "mkAppTy") mkAppTyKey
mkTrConName = varQual tYPEABLE_INTERNAL (fsLit "mkTrCon") mkTrConKey
mkTrAppName = varQual tYPEABLE_INTERNAL (fsLit "mkTrApp") mkTrAppKey
mkTrFunName = varQual tYPEABLE_INTERNAL (fsLit "mkTrFun") mkTrFunKey
typeNatTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey
-- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types)
......@@ -1802,11 +1848,14 @@ callStackTyConKey :: Unique
callStackTyConKey = mkPreludeTyConUnique 183
-- Typeables
typeRepTyConKey :: Unique
typeRepTyConKey = mkPreludeTyConUnique 184
typeRepTyConKey, someTypeRepTyConKey, someTypeRepDataConKey :: Unique
typeRepTyConKey = mkPreludeTyConUnique 184
someTypeRepTyConKey = mkPreludeTyConUnique 185
someTypeRepDataConKey = mkPreludeTyConUnique 186
typeSymbolAppendFamNameKey :: Unique
typeSymbolAppendFamNameKey = mkPreludeTyConUnique 185
typeSymbolAppendFamNameKey = mkPreludeTyConUnique 187
---------------- Template Haskell -------------------
-- THNames.hs: USES TyConUniques 200-299
......@@ -1888,15 +1937,18 @@ srcLocDataConKey = mkPreludeDataConUnique 37
trTyConTyConKey, trTyConDataConKey,
trModuleTyConKey, trModuleDataConKey,
trNameTyConKey, trNameSDataConKey, trNameDDataConKey,
trGhcPrimModuleKey :: Unique
trTyConTyConKey = mkPreludeDataConUnique 41
trTyConDataConKey = mkPreludeDataConUnique 42
trModuleTyConKey = mkPreludeDataConUnique 43
trModuleDataConKey = mkPreludeDataConUnique 44
trNameTyConKey = mkPreludeDataConUnique 45
trNameSDataConKey = mkPreludeDataConUnique 46
trNameDDataConKey = mkPreludeDataConUnique 47
trGhcPrimModuleKey = mkPreludeDataConUnique 48
trGhcPrimModuleKey, kindRepTyConKey,
typeLitSortTyConKey :: Unique
trTyConTyConKey = mkPreludeDataConUnique 40
trTyConDataConKey = mkPreludeDataConUnique 41
trModuleTyConKey = mkPreludeDataConUnique 42
trModuleDataConKey = mkPreludeDataConUnique 43
trNameTyConKey = mkPreludeDataConUnique 44
trNameSDataConKey = mkPreludeDataConUnique 45
trNameDDataConKey = mkPreludeDataConUnique 46
trGhcPrimModuleKey = mkPreludeDataConUnique 47
kindRepTyConKey = mkPreludeDataConUnique 48
typeLitSortTyConKey = mkPreludeDataConUnique 49
typeErrorTextDataConKey,
typeErrorAppendDataConKey,
......@@ -1955,8 +2007,26 @@ vecCountDataConKeys = map mkPreludeDataConUnique [83..88]
vecElemDataConKeys :: [Unique]
vecElemDataConKeys = map mkPreludeDataConUnique [89..98]
-- Typeable things
kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey,
kindRepFunDataConKey, kindRepTYPEDataConKey,
kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey
:: Unique
kindRepTyConAppDataConKey = mkPreludeDataConUnique 100
kindRepVarDataConKey = mkPreludeDataConUnique 101
kindRepAppDataConKey = mkPreludeDataConUnique 102
kindRepFunDataConKey = mkPreludeDataConUnique 103
kindRepTYPEDataConKey = mkPreludeDataConUnique 104
kindRepTypeLitSDataConKey = mkPreludeDataConUnique 105
kindRepTypeLitDDataConKey = mkPreludeDataConUnique 106
typeLitSymbolDataConKey, typeLitNatDataConKey :: Unique
typeLitSymbolDataConKey = mkPreludeDataConUnique 107
typeLitNatDataConKey = mkPreludeDataConUnique 108
---------------- Template Haskell -------------------
-- THNames.hs: USES DataUniques 100-150
-- THNames.hs: USES DataUniques 200-250
-----------------------------------------------------
......@@ -2229,41 +2299,54 @@ proxyHashKey = mkPreludeMiscIdUnique 502
-- Used to make `Typeable` dictionaries
mkTyConKey
, mkPolyTyConAppKey
, mkAppTyKey
, mkTrConKey
, mkTrAppKey
, mkTrFunKey
, typeNatTypeRepKey
, typeSymbolTypeRepKey
, typeRepIdKey
:: Unique
mkTyConKey = mkPreludeMiscIdUnique 503
mkPolyTyConAppKey = mkPreludeMiscIdUnique 504
mkAppTyKey = mkPreludeMiscIdUnique 505
mkTrConKey = mkPreludeMiscIdUnique 504
mkTrAppKey = mkPreludeMiscIdUnique 505
typeNatTypeRepKey = mkPreludeMiscIdUnique 506
typeSymbolTypeRepKey = mkPreludeMiscIdUnique 507
typeRepIdKey = mkPreludeMiscIdUnique 508
mkTrFunKey = mkPreludeMiscIdUnique 509
-- Representations for primitive types
trTYPEKey
,trTYPE'PtrRepLiftedKey
, trRuntimeRepKey
, tr'PtrRepLiftedKey
:: Unique
trTYPEKey = mkPreludeMiscIdUnique 510
trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 511
trRuntimeRepKey = mkPreludeMiscIdUnique 512
tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 513
-- Dynamic
toDynIdKey :: Unique
toDynIdKey = mkPreludeMiscIdUnique 509
toDynIdKey = mkPreludeMiscIdUnique 550
bitIntegerIdKey :: Unique
bitIntegerIdKey = mkPreludeMiscIdUnique 510
bitIntegerIdKey = mkPreludeMiscIdUnique 551
heqSCSelIdKey, coercibleSCSelIdKey :: Unique
heqSCSelIdKey = mkPreludeMiscIdUnique 511
coercibleSCSelIdKey = mkPreludeMiscIdUnique 512
heqSCSelIdKey = mkPreludeMiscIdUnique 552
coercibleSCSelIdKey = mkPreludeMiscIdUnique 553
sappendClassOpKey :: Unique
sappendClassOpKey = mkPreludeMiscIdUnique 513
sappendClassOpKey = mkPreludeMiscIdUnique 554
memptyClassOpKey, mappendClassOpKey, mconcatClassOpKey :: Unique
memptyClassOpKey = mkPreludeMiscIdUnique 514
mappendClassOpKey = mkPreludeMiscIdUnique 515
mconcatClassOpKey = mkPreludeMiscIdUnique 516
memptyClassOpKey = mkPreludeMiscIdUnique 555
mappendClassOpKey = mkPreludeMiscIdUnique 556
mconcatClassOpKey = mkPreludeMiscIdUnique 557
emptyCallStackKey, pushCallStackKey :: Unique
emptyCallStackKey = mkPreludeMiscIdUnique 517
pushCallStackKey = mkPreludeMiscIdUnique 518
emptyCallStackKey = mkPreludeMiscIdUnique 558
pushCallStackKey = mkPreludeMiscIdUnique 559
fromStaticPtrClassOpKey :: Unique
fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 519
......
......@@ -678,40 +678,40 @@ derivStrategyTyConKey = mkPreludeTyConUnique 235
-- data Inline = ...
noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
noInlineDataConKey = mkPreludeDataConUnique 100
inlineDataConKey = mkPreludeDataConUnique 101
inlinableDataConKey = mkPreludeDataConUnique 102
noInlineDataConKey = mkPreludeDataConUnique 200
inlineDataConKey = mkPreludeDataConUnique 201
inlinableDataConKey = mkPreludeDataConUnique 202
-- data RuleMatch = ...
conLikeDataConKey, funLikeDataConKey :: Unique
conLikeDataConKey = mkPreludeDataConUnique 103
funLikeDataConKey = mkPreludeDataConUnique 104
conLikeDataConKey = mkPreludeDataConUnique 203
funLikeDataConKey = mkPreludeDataConUnique 204
-- data Phases = ...
allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
allPhasesDataConKey = mkPreludeDataConUnique 105
fromPhaseDataConKey = mkPreludeDataConUnique 106
beforePhaseDataConKey = mkPreludeDataConUnique 107
allPhasesDataConKey = mkPreludeDataConUnique 205
fromPhaseDataConKey = mkPreludeDataConUnique 206
beforePhaseDataConKey = mkPreludeDataConUnique 207
-- newtype TExp a = ...
tExpDataConKey :: Unique
tExpDataConKey = mkPreludeDataConUnique 108
tExpDataConKey = mkPreludeDataConUnique 208
-- data Overlap = ..
overlappableDataConKey,
overlappingDataConKey,
overlapsDataConKey,
incoherentDataConKey :: Unique
overlappableDataConKey = mkPreludeDataConUnique 109
overlappingDataConKey = mkPreludeDataConUnique 110
overlapsDataConKey = mkPreludeDataConUnique 111
incoherentDataConKey = mkPreludeDataConUnique 112
overlappableDataConKey = mkPreludeDataConUnique 209
overlappingDataConKey = mkPreludeDataConUnique 210
overlapsDataConKey = mkPreludeDataConUnique 211
incoherentDataConKey = mkPreludeDataConUnique 212
-- data DerivStrategy = ...
stockDataConKey, anyclassDataConKey, newtypeDataConKey :: Unique
stockDataConKey = mkPreludeDataConUnique 113
anyclassDataConKey = mkPreludeDataConUnique 114
newtypeDataConKey = mkPreludeDataConUnique 115
stockDataConKey = mkPreludeDataConUnique 213
anyclassDataConKey = mkPreludeDataConUnique 214
newtypeDataConKey = mkPreludeDataConUnique 215
{- *********************************************************************
* *
......
......@@ -865,7 +865,7 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
tc_res_kind = unboxedTupleKind rr_tys
tc_arity = arity * 2
flavour = UnboxedAlgTyCon
flavour = UnboxedAlgTyCon (mkPrelTyConRepName tc_name)
dc_tvs = binderVars tc_binders
(rr_tys, dc_arg_tys) = splitAt arity (mkTyVarTys dc_tvs)
......@@ -974,7 +974,7 @@ mk_sum :: Arity -> (TyCon, Array ConTagZ DataCon)
mk_sum arity = (tycon, sum_cons)
where
tycon = mkSumTyCon tc_name tc_binders tc_res_kind (arity * 2) tyvars (elems sum_cons)
UnboxedAlgTyCon
(UnboxedAlgTyCon (mkPrelTyConRepName tc_name))
tc_binders = mkTemplateTyConBinders (nOfThem arity runtimeRepTy)
(\ks -> map tYPE ks)
......
......@@ -60,25 +60,22 @@ import Data.List ( sortBy, mapAccumL )
import Data.Maybe ( isJust )
import qualified Data.Set as Set ( difference, fromList, toList, null )
{-
@rnSourceDecl@ `renames' declarations.
{- | @rnSourceDecl@ "renames" declarations.
It simultaneously performs dependency analysis and precedence parsing.
It also does the following error checks:
\begin{enumerate}
\item
Checks that tyvars are used properly. This includes checking
for undefined tyvars, and tyvars in contexts that are ambiguous.
(Some of this checking has now been moved to module @TcMonoType@,
since we don't have functional dependency information at this point.)
\item
Checks that all variable occurrences are defined.
\item
Checks the @(..)@ etc constraints in the export list.
\end{enumerate}
-}
-- Brings the binders of the group into scope in the appropriate places;
-- does NOT assume that anything is in scope already
* Checks that tyvars are used properly. This includes checking
for undefined tyvars, and tyvars in contexts that are ambiguous.
(Some of this checking has now been moved to module @TcMonoType@,
since we don't have functional dependency information at this point.)
* Checks that all variable occurrences are defined.
* Checks the @(..)@ etc constraints in the export list.
Brings the binders of the group into scope in the appropriate places;
does NOT assume that anything is in scope already
-}
rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
-- Rename a top-level HsGroup; used for normal source files *and* hs-boot files
rnSrcDecls group@(HsGroup { hs_valds = val_decls,
......
......@@ -438,8 +438,8 @@ inheritedSigPvpWarning =
-- the export lists of two signatures is just merging the declarations
-- of two signatures writ small. Of course, in GHC Haskell, there are a
-- few important things which are not explicitly exported but still can
-- be used: in particular, dictionary functions for instances and
-- coercion axioms for type families also count.
-- be used: in particular, dictionary functions for instances, Typeable
-- TyCon bindings, and coercion axioms for type families also count.
--
-- When handling these non-exported things, there two primary things
-- we need to watch out for:
......
......@@ -493,19 +493,24 @@ data EvTerm
-- | Instructions on how to make a 'Typeable' dictionary.
-- See Note [Typeable evidence terms]
data EvTypeable
= EvTypeableTyCon [EvTerm] -- ^ Dictionary for @Typeable (T k1..kn)@.
-- The EvTerms are for the arguments
= EvTypeableTyCon TyCon [EvTerm]
-- ^ Dictionary for @Typeable T@ where @T@ is a type constructor with all of
-- its kind variables saturated. The @[EvTerm]@ is @Typeable@ evidence for
-- the applied kinds..
| EvTypeableTyApp EvTerm EvTerm
-- ^ Dictionary for @Typeable (s t)@,
-- given a dictionaries for @s@ and @t@
-- given a dictionaries for @s@ and @t@.
| EvTypeableTrFun EvTerm EvTerm
-- ^ Dictionary for @Typeable (s -> t)@,
-- given a dictionaries for @s@ and @t@.
| EvTypeableTyLit EvTerm
-- ^ Dictionary for a type literal,
-- e.g. @Typeable "foo"@ or @Typeable 3@
-- The 'EvTerm' is evidence of, e.g., @KnownNat 3@
-- (see Trac #10348)
deriving Data.Data
data EvLit
......@@ -817,8 +822,9 @@ evVarsOfCallStack cs = case cs of
evVarsOfTypeable :: EvTypeable -> VarSet
evVarsOfTypeable ev =
case ev of
EvTypeableTyCon es -> evVarsOfTerms es
EvTypeableTyCon _ e -> mapUnionVarSet evVarsOfTerm e
EvTypeableTyApp e1 e2 -> evVarsOfTerms [e1,e2]
EvTypeableTrFun e1 e2 -> evVarsOfTerms [e1,e2]
EvTypeableTyLit e -> evVarsOfTerm e
{-
......@@ -908,8 +914,9 @@ instance Outputable EvCallStack where
= ppr (name,loc) <+> text ":" <+> ppr tm
instance Outputable EvTypeable where
ppr (EvTypeableTyCon ts) = text "TC" <+> ppr ts
ppr (EvTypeableTyCon ts _) = text "TyCon" <+> ppr ts
ppr (EvTypeableTyApp t1 t2) = parens (ppr t1 <+> ppr t2)
ppr (EvTypeableTrFun t1 t2) = parens (ppr t1 <+> arrow <+> ppr t2)
ppr (EvTypeableTyLit t1) = text "TyLit" <> ppr t1
......
......@@ -615,7 +615,7 @@ zonkLExprs env exprs = mapM (zonkLExpr env) exprs
zonkLExpr env expr = wrapLocM (zonkExpr env) expr
zonkExpr env (HsVar (L l id))
= ASSERT( isNothing (isDataConId_maybe id) )
= ASSERT2( isNothing (isDataConId_maybe id), ppr id )
return (HsVar (L l (zonkIdOcc env id)))
zonkExpr _ e@(HsConLikeOut {}) = return e
......@@ -1451,13 +1451,17 @@ zonkEvTerm env (EvSelector sel_id tys tms)