Do not generate a data-con wrapper for !Int#
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 9 Mar 2017 15:58:32 +0000 (15:58 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 10 Mar 2017 13:00:48 +0000 (13:00 +0000)
See Note [Data con wrappers and unlifted types] in MkId.
We were being totally stupid!

See Trac #1600 comment:66

compiler/basicTypes/DataCon.hs
compiler/basicTypes/MkId.hs

index 43bcf75..c6bb8eb 100644 (file)
@@ -504,7 +504,7 @@ data HsSrcBang =
 -- Bangs of data constructor arguments as generated by the compiler
 -- after consulting HsSrcBang, flags, etc.
 data HsImplBang
-  = HsLazy  -- ^ Lazy field
+  = HsLazy    -- ^ Lazy field, or one with an unlifted type
   | HsStrict  -- ^ Strict but not unpacked field
   | HsUnpack (Maybe Coercion)
     -- ^ Strict and unpacked field
index 890a4bf..6be2b5c 100644 (file)
@@ -657,6 +657,18 @@ the interface file.
 The HsImplBangs passed are in 1-1 correspondence with the
 dataConOrigArgTys of the DataCon.
 
+Note [Data con wrappers and unlifted types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+   data T = MkT !Int#
+
+We certainly do not want to make a wrapper
+   $WMkT x = case x of y { DEFAULT -> MkT y }
+
+For a start, it's still to generate a no-op.  But worse, since wrappers
+are currently injected at TidyCore, we don't even optimise it away!
+So the stupid case expression stays there.  This actually happened for
+the Integer data type (see Trac #1600 comment:66)!
 -}
 
 -------------------------
@@ -673,7 +685,7 @@ dataConSrcToImplBang
    -> HsImplBang
 
 dataConSrcToImplBang dflags fam_envs arg_ty
-              (HsSrcBang ann unpk NoSrcStrict)
+                     (HsSrcBang ann unpk NoSrcStrict)
   | xopt LangExt.StrictData dflags -- StrictData => strict field
   = dataConSrcToImplBang dflags fam_envs arg_ty
                   (HsSrcBang ann unpk SrcStrict)
@@ -684,7 +696,11 @@ dataConSrcToImplBang _ _ _ (HsSrcBang _ _ SrcLazy)
   = HsLazy
 
 dataConSrcToImplBang dflags fam_envs arg_ty
-    (HsSrcBang _ unpk_prag SrcStrict)
+                     (HsSrcBang _ unpk_prag SrcStrict)
+  | isUnliftedType arg_ty
+  = HsLazy  -- For !Int#, say, use HsLazy
+            -- See Note [Data con wrappers and unlifted types]
+
   | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas
           -- Don't unpack if we aren't optimising; rather arbitrarily,
           -- we use -fomit-iface-pragmas as the indication