[commit: ghc] wip/ttypeable: Make unboxed sums not Typeable (ad6d51c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/ad6d51c4d4561ff4eeade88158b4f9dc4dea8ec0/ghc

>---------------------------------------------------------------

commit ad6d51c4d4561ff4eeade88158b4f9dc4dea8ec0
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Sun Feb 12 12:54:59 2017 -0500

    Make unboxed sums not Typeable


>---------------------------------------------------------------

ad6d51c4d4561ff4eeade88158b4f9dc4dea8ec0
 compiler/prelude/TysWiredIn.hs | 5 +++--
 compiler/types/TyCon.hs        | 9 +++++----
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 4c70382..77fef17 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -865,7 +865,7 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
     tc_res_kind = unboxedTupleKind rr_tys
 
     tc_arity    = arity * 2
-    flavour     = UnboxedAlgTyCon (mkPrelTyConRepName tc_name)
+    flavour     = UnboxedAlgTyCon $ Just (mkPrelTyConRepName tc_name)
 
     dc_tvs               = binderVars tc_binders
     (rr_tys, dc_arg_tys) = splitAt arity (mkTyVarTys dc_tvs)
@@ -976,7 +976,8 @@ mk_sum arity = (tycon, sum_cons)
     tycon   = mkSumTyCon tc_name tc_binders tc_res_kind (arity * 2) tyvars (elems sum_cons)
                          (UnboxedAlgTyCon rep_name)
 
-    rep_name = mkPrelTyConRepName tc_name
+    -- Unboxed sums are currently not Typeable due to efficiency concerns. See #13276.
+    rep_name = Nothing -- Just $ mkPrelTyConRepName tc_name
 
     tc_binders = mkTemplateTyConBinders (nOfThem arity runtimeRepTy)
                                         (\ks -> map tYPE ks)
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 1c749dc..e82d0cf 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -895,10 +895,11 @@ data AlgTyConFlav
     VanillaAlgTyCon
        TyConRepName
 
-    -- | An unboxed type constructor. Note that this carries no TyConRepName
-    -- as it is not representable.
+    -- | An unboxed type constructor. The TyConRepName is a Maybe since we
+    -- currently don't allow unboxed sums to be Typeable since there are too
+    -- many of them. See #13276.
   | UnboxedAlgTyCon
-       TyConRepName
+       (Maybe TyConRepName)
 
   -- | Type constructors representing a class dictionary.
   -- See Note [ATyCon for classes] in TyCoRep
@@ -1170,7 +1171,7 @@ tyConRepName_maybe (PrimTyCon  { primRepName = mb_rep_nm })
 tyConRepName_maybe (AlgTyCon { algTcParent = parent })
   | VanillaAlgTyCon rep_nm <- parent = Just rep_nm
   | ClassTyCon _ rep_nm    <- parent = Just rep_nm
-  | UnboxedAlgTyCon rep_nm    <- parent = Just rep_nm
+  | UnboxedAlgTyCon rep_nm <- parent = rep_nm
 tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm })
   = Just rep_nm
 tyConRepName_maybe (PromotedDataCon { tcRepName = rep_nm })