[commit: ghc] master: Disable Typeable binding generation for unboxed sums (42ff5d9)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/42ff5d97b486d50b0d10e474f47e86822bb71ace/ghc

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

commit 42ff5d97b486d50b0d10e474f47e86822bb71ace
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Sun Feb 12 09:06:00 2017 -0500

    Disable Typeable binding generation for unboxed sums
    
    These things are simply too expensive to generate at the moment. More
    work is needed here; see #13276 and #13261.


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

42ff5d97b486d50b0d10e474f47e86822bb71ace
 compiler/prelude/TysWiredIn.hs      | 7 +++++--
 compiler/types/TyCon.hs             | 9 +++++----
 testsuite/tests/perf/compiler/all.T | 4 ++--
 testsuite/tests/th/TH_Roles2.stderr | 4 ++--
 4 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 85771a0..b683564 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)
@@ -974,7 +974,10 @@ 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 (mkPrelTyConRepName tc_name))
+                         (UnboxedAlgTyCon rep_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 7140009..8f1082d 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 })
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 24b03d0..7ebfb89 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -926,10 +926,10 @@ test('T12227',
 test('T12425',
      [ only_ways(['optasm']),
        compiler_stats_num_field('bytes allocated',
-          [(wordsize(64), 173257664, 5),
+          [(wordsize(64), 153611448, 5),
           # initial:    125831400
           # 2017-01-18: 133380960  Allow top-level string literals in Core
-          # 2017-02-17: 173257664  Type-indexed Typeable
+          # 2017-02-17: 153611448  Type-indexed Typeable
           ]),
      ],
      compile,
diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr
index 7b872aa..3027911 100644
--- a/testsuite/tests/th/TH_Roles2.stderr
+++ b/testsuite/tests/th/TH_Roles2.stderr
@@ -16,8 +16,8 @@ TH_Roles2.$tcT
       TH_Roles2.$trModule
       (GHC.Types.TrNameS "T"#)
       1
-      krep_a7XD
-krep_a7XD [InlPrag=[~]]
+      krep_a4im
+krep_a4im [InlPrag=[~]]
   = GHC.Types.KindRepFun
       (GHC.Types.KindRepVar 0)
       (GHC.Types.KindRepTYPE GHC.Types.LiftedRep)