diff options
Diffstat (limited to 'compiler/typecheck/TcTyClsDecls.hs')
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.hs | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 27e2d45a03..484b89bb19 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -1589,15 +1589,16 @@ checkValidDataCon dflags existential_ok tc con } where ctxt = ConArgCtxt (dataConName con) - check_bang (HsSrcBang (Just want_unpack) has_bang, rep_bang, n) - | want_unpack, not has_bang + check_bang (HsSrcBang (Just want_unpack) mb_bang, rep_bang, n) + | want_unpack, not is_strict = addWarnTc (bad_bang n (ptext (sLit "UNPACK pragma lacks '!'"))) | want_unpack , case rep_bang of { HsUnpack {} -> False; _ -> True } , not (gopt Opt_OmitInterfacePragmas dflags) - -- If not optimising, se don't unpack, so don't complain! + -- If not optimising, we don't unpack, so don't complain! -- See MkId.dataConArgRep, the (HsBang True) case = addWarnTc (bad_bang n (ptext (sLit "Ignoring unusable UNPACK pragma"))) + where is_strict = mb_bang == Just True || xopt Opt_StrictData dflags check_bang _ = return () @@ -1623,7 +1624,8 @@ checkNewDataCon con ptext (sLit "A newtype constructor cannot have existential type variables") -- No existentials - ; checkTc (not (any isBanged (dataConSrcBangs con))) + ; dflags <- getDynFlags + ; checkTc (not (any (isBanged dflags) (dataConSrcBangs con))) (newtypeStrictError con) -- No strictness } |