diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-03-09 15:58:32 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-03-10 13:00:48 +0000 |
commit | 900cfdc2700ad9e8c7a12dd25bb0396e5e7651df (patch) | |
tree | 5aa51240b184079656639079109c1a57db20182f | |
parent | 46246a6d57c35ebf12032d13a4cd7ff18f713770 (diff) | |
download | haskell-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.hs | 2 | ||||
-rw-r--r-- | compiler/basicTypes/MkId.hs | 20 |
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 |