Disable Typeable binding generation for unboxed sums
authorBen Gamari <ben@smart-cactus.org>
Sun, 12 Feb 2017 14:06:00 +0000 (09:06 -0500)
committerBen Gamari <ben@smart-cactus.org>
Sat, 18 Feb 2017 05:09:51 +0000 (00:09 -0500)
These things are simply too expensive to generate at the moment. More
work is needed here; see #13276 and #13261.

compiler/prelude/TysWiredIn.hs
compiler/types/TyCon.hs
testsuite/tests/perf/compiler/all.T
testsuite/tests/th/TH_Roles2.stderr

index 85771a0..b683564 100644 (file)
@@ -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)
index 7140009..8f1082d 100644 (file)
@@ -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 })
index 24b03d0..7ebfb89 100644 (file)
@@ -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,
index 7b872aa..3027911 100644 (file)
@@ -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)