diff options
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Deriv/Generics.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/Splice.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Tc/TyCl.hs | 18 |
3 files changed, 13 insertions, 13 deletions
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs index 509282d3e5..41e7bb3e92 100644 --- a/compiler/GHC/Tc/Deriv/Generics.hs +++ b/compiler/GHC/Tc/Deriv/Generics.hs @@ -689,7 +689,7 @@ tc_mkRepTy gk get_fixity dit@(DerivInstTys{ dit_rep_tc = tycon pDStrness = mkTyConTy $ case ib of HsLazy -> pDLzy - HsStrict -> pDStr + HsStrict _ -> pDStr HsUnpack{} -> pDUpk return (mkD tycon) diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index c12ab7a1aa..943c8dcbd2 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -2781,9 +2781,9 @@ reifySourceBang :: DataCon.HsSrcBang reifySourceBang (HsSrcBang _ u s) = (reifyUnpackedness u, reifyStrictness s) reifyDecidedStrictness :: DataCon.HsImplBang -> TH.DecidedStrictness -reifyDecidedStrictness HsLazy = TH.DecidedLazy -reifyDecidedStrictness HsStrict = TH.DecidedStrict -reifyDecidedStrictness HsUnpack{} = TH.DecidedUnpack +reifyDecidedStrictness HsLazy = TH.DecidedLazy +reifyDecidedStrictness (HsStrict _) = TH.DecidedStrict +reifyDecidedStrictness HsUnpack{} = TH.DecidedUnpack reifyTypeOfThing :: TH.Name -> TcM TH.Type reifyTypeOfThing th_name = do diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index 25900f2103..f3e02c0fd0 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -4446,9 +4446,6 @@ checkValidDataCon dflags existential_ok tc con checkTc (all isEqPred (dataConOtherTheta con)) (TcRnConstraintInKind (dataConRepType con)) - -- Check that UNPACK pragmas and bangs work out - -- E.g. reject data T = MkT {-# UNPACK #-} Int -- No "!" - -- data T = MkT {-# UNPACK #-} !a -- Can't unpack ; hsc_env <- getTopEnv ; let check_bang :: Type -> HsSrcBang -> HsImplBang -> Int -> TcM () check_bang orig_arg_ty bang rep_bang n @@ -4457,6 +4454,8 @@ checkValidDataCon dflags existential_ok tc con = addErrTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ (bad_bang n (text "Lazy annotation (~) without StrictData")) + -- Warn about UNPACK without "!" + -- e.g. data T = MkT {-# UNPACK #-} Int | HsSrcBang _ want_unpack strict_mark <- bang , isSrcUnpacked want_unpack, not (is_strict strict_mark) , not (isUnliftedType orig_arg_ty) @@ -4475,13 +4474,14 @@ checkValidDataCon dflags existential_ok tc con , isUnliftedType orig_arg_ty = addDiagnosticTc $ TcRnLazyBangOnUnliftedType orig_arg_ty + -- Warn about unusable UNPACK pragmas + -- e.g. data T a = MkT {-# UNPACK #-} !a -- Can't unpack | HsSrcBang _ want_unpack _ <- bang - , isSrcUnpacked want_unpack - , case rep_bang of { HsUnpack {} -> False; _ -> True } - -- If not optimising, we don't unpack (rep_bang is never - -- HsUnpack), so don't complain! This happens, e.g., in Haddock. - -- See dataConSrcToImplBang. - , not (bang_opt_unbox_disable bang_opts) + + -- See Note [Detecting useless UNPACK pragmas] in GHC.Core.DataCon. + , isSrcUnpacked want_unpack -- this means the user wrote {-# UNPACK #-} + , case rep_bang of { HsUnpack {} -> False; HsStrict True -> False; _ -> True } + -- When typechecking an indefinite package in Backpack, we -- may attempt to UNPACK an abstract type. The test here will -- conclude that this is unusable, but it might become usable |