Commit 076f5862 authored by Ryan Scott's avatar Ryan Scott
Browse files

Don't invoke dataConSrcToImplBang on newtypes

parent 19670bc3
......@@ -616,6 +616,8 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
, dcr_boxer = mk_boxer boxers
, dcr_arg_tys = rep_tys
, dcr_stricts = rep_strs
-- For newtypes, dcr_bangs is always [HsLazy].
-- See Note [HsImplBangs for newtypes].
, dcr_bangs = arg_ibangs }) }
......@@ -637,11 +639,16 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
-- Because we are going to apply the eq_spec args manually in the
-- wrapper
arg_ibangs =
case mb_bangs of
Nothing -> zipWith (dataConSrcToImplBang dflags fam_envs)
orig_arg_tys orig_bangs
Just bangs -> bangs
new_tycon = isNewTyCon tycon
| new_tycon
= ASSERT( isSingleton orig_arg_tys )
[HsLazy] -- See Note [HsImplBangs for newtypes]
| otherwise
= case mb_bangs of
Nothing -> zipWith (dataConSrcToImplBang dflags fam_envs)
orig_arg_tys orig_bangs
Just bangs -> bangs
(rep_tys_w_strs, wrappers)
= unzip (zipWith dataConArgRep all_arg_tys (ev_ibangs ++ arg_ibangs))
......@@ -650,7 +657,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
(rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)
wrapper_reqd =
(not (isNewTyCon tycon)
(not new_tycon
-- (Most) newtypes have only a worker, with the exception
-- of some newtypes written with GADT syntax. See below.
&& (any isBanged (ev_ibangs ++ arg_ibangs)
......@@ -774,6 +781,29 @@ wrappers! After all, a newtype can also be written with GADT syntax:
Again, this needs a wrapper data con to reorder the type variables. It does
mean that this newtype constructor requires another level of indirection when
being called, but the inliner should make swift work of that.
Note [HsImplBangs for newtypes]
Most of the time, we use the dataConSrctoImplBang function to decide what
strictness/unpackedness to use for the fields of a data type constructor. But
there is an exception to this rule: newtype constructors. You might not think
that newtypes would pose a challenge, since newtypes are seemingly forbidden
from having strictness annotations in the first place. But consider this
(from Trac #16141):
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -O #-}
newtype T a b where
MkT :: forall b a. Int -> T a b
Because StrictData (plus optimization) is enabled, invoking
dataConSrcToImplBang would sneak in and unpack the field of type Int to Int#!
This would be disastrous, since the wrapper for `MkT` uses a coercion involving
Int, not Int#.
Bottom line: dataConSrcToImplBang should never be invoked for newtypes. In the
case of a newtype constructor, we simply hardcode its dcr_bangs field to
......@@ -781,7 +811,11 @@ newLocal :: Type -> UniqSM Var
newLocal ty = do { uniq <- getUniqueM
; return (mkSysLocalOrCoVar (fsLit "dt") uniq ty) }
-- | Unpack/Strictness decisions from source module
-- | Unpack/Strictness decisions from source module.
-- This function should only ever be invoked for data constructor fields, and
-- never on the field of a newtype constructor.
-- See @Note [HsImplBangs for newtypes]@.
:: DynFlags
-> FamInstEnvs
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
module T16141 where
data family T1
newtype instance T1 = MkT1 Int
deriving Eq
newtype T2 a b where
MkT2 :: forall b a. Int -> T2 a b
deriving Eq
......@@ -663,3 +663,4 @@ test('T15778', normal, compile, [''])
test('T14761c', normal, compile, [''])
test('T16008', normal, compile, [''])
test('T16033', normal, compile, [''])
test('T16141', normal, compile, ['-O'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment