#16141: StrictData and TypeFamilies regression -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.6.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): My hunch appears to be correct. The [https://gitlab.haskell.org/ghc/ghc/blob/master/compiler/basicTypes/MkId.hs#L... dataConSrcToImplBang] function is what is responsible for making decisions about strictness/unpacking w.r.t. `StrictData`: {{{#!hs -- | Unpack/Strictness decisions from source module dataConSrcToImplBang :: DynFlags -> FamInstEnvs -> Type -> HsSrcBang -> HsImplBang dataConSrcToImplBang dflags fam_envs arg_ty (HsSrcBang ann unpk NoSrcStrict) | xopt LangExt.StrictData dflags -- StrictData => strict field = dataConSrcToImplBang dflags fam_envs arg_ty (HsSrcBang ann unpk SrcStrict) | otherwise -- no StrictData => lazy field = HsLazy }}} Notice that this does not take into account whether the `Type` of the field belongs to a newtype or not, so this will indeed unpack the field of a newtype with `StrictData` + `-O` enabled. Yikes. One could fix this by propagating information about whether we're in a newtype or not to `dataConSrcToImplBang`. But then again, should we really even need to call `dataConSrcToImplBang` if we're dealing with a newtype? `dataConSrcToImplBang` is internal to `MkId` and only has one call site, so I'm inclined to just avoid invoking it at its call site, like so: {{{#!diff diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 5a6f1fbf96..fa3d6785b7 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -637,11 +637,15 @@ 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 + arg_ibangs + | new_tycon + = nOfThem (length orig_arg_tys) HsLazy + | 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 +654,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) }}} This certainly fixes the two programs in this ticket, and it passes the rest of the testsuite. Does this sound like the right approach? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/16141#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler