summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2017-03-09 15:58:32 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2017-03-10 13:00:48 +0000
commit900cfdc2700ad9e8c7a12dd25bb0396e5e7651df (patch)
tree5aa51240b184079656639079109c1a57db20182f
parent46246a6d57c35ebf12032d13a4cd7ff18f713770 (diff)
downloadhaskell-900cfdc2700ad9e8c7a12dd25bb0396e5e7651df.tar.gz
Do not generate a data-con wrapper for !Int#
See Note [Data con wrappers and unlifted types] in MkId. We were being totally stupid! See Trac #1600 comment:66
-rw-r--r--compiler/basicTypes/DataCon.hs2
-rw-r--r--compiler/basicTypes/MkId.hs20
2 files changed, 19 insertions, 3 deletions
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 43bcf75bb4..c6bb8eb5c7 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -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
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 890a4bf425..6be2b5cbba 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -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