Vladislav Zavialov pushed to branch wip/int-index/unusable-unpack-pragma-flag at Glasgow Haskell Compiler / GHC Commits: a83bbd11 by Vladislav Zavialov at 2025-04-19T17:27:34+03:00 Add name for -Wunusable-unpack-pragmas This warning had no name or flag and was triggered unconditionally. Now it is part of -Wdefault. In GHC.Tc.TyCl.tcTyClGroupsPass's strict mode, we now have to force-enable this warning to ensure that detection of flawed groups continues to work even if the user disables the warning with the -Wno-unusable-unpack-pragmas option. Test case: T3990c Also, the misnamed BackpackUnpackAbstractType is now called UnusableUnpackPragma. - - - - - 21 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.14.1-notes.rst - docs/users_guide/using-warnings.rst - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T23307c.stderr - + testsuite/tests/simplCore/should_compile/T3990c.hs - + testsuite/tests/simplCore/should_compile/T3990c.stdout - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/simplCore/should_fail/T25672.stderr - testsuite/tests/typecheck/should_compile/T7050.stderr - testsuite/tests/typecheck/should_fail/T3966.stderr - + testsuite/tests/typecheck/should_fail/T3966b.hs - + testsuite/tests/typecheck/should_fail/T3966b.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/unboxedsums/unpack_sums_5.stderr Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -1098,6 +1098,7 @@ data WarningFlag = -- ^ @since 9.14, scheduled to be removed in 9.18 -- -- See Note [Quantifying over equalities in RULES] in GHC.Tc.Gen.Sig + | Opt_WarnUnusableUnpackPragmas -- Since 9.14 deriving (Eq, Ord, Show, Enum, Bounded) -- | Return the names of a WarningFlag @@ -1217,6 +1218,7 @@ warnFlagNames wflag = case wflag of Opt_WarnUselessSpecialisations -> "useless-specialisations" :| ["useless-specializations"] Opt_WarnDeprecatedPragmas -> "deprecated-pragmas" :| [] Opt_WarnRuleLhsEqualities -> "rule-lhs-equalities" :| [] + Opt_WarnUnusableUnpackPragmas -> "unusable-unpack-pragmas" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -1362,7 +1364,8 @@ standardWarnings -- see Note [Documenting warning flags] Opt_WarnViewPatternSignatures, Opt_WarnUselessSpecialisations, Opt_WarnDeprecatedPragmas, - Opt_WarnRuleLhsEqualities + Opt_WarnRuleLhsEqualities, + Opt_WarnUnusableUnpackPragmas ] -- | Things you get with @-W@. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2384,6 +2384,7 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of Opt_WarnUselessSpecialisations -> warnSpec x Opt_WarnDeprecatedPragmas -> warnSpec x Opt_WarnRuleLhsEqualities -> warnSpec x + Opt_WarnUnusableUnpackPragmas -> warnSpec x warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] warningGroupsDeps = map mk warningGroups ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2504,6 +2504,8 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnIncompleteRecordSelectors TcRnBadFieldAnnotation _ _ LazyFieldsDisabled -> ErrorWithoutFlag + TcRnBadFieldAnnotation _ _ UnusableUnpackPragma + -> WarningWithFlag Opt_WarnUnusableUnpackPragmas TcRnBadFieldAnnotation{} -> WarningWithoutFlag TcRnSuperclassCycle{} @@ -5802,7 +5804,7 @@ pprBadFieldAnnotationReason = \case text "Lazy field annotations (~) are disabled" UnpackWithoutStrictness -> text "UNPACK pragma lacks '!'" - BackpackUnpackAbstractType -> + UnusableUnpackPragma -> text "Ignoring unusable UNPACK pragma" pprSuperclassCycleDetail :: SuperclassCycleDetail -> SDoc ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -6257,13 +6257,28 @@ data BadFieldAnnotationReason where T14761a, T7562 -} UnpackWithoutStrictness :: BadFieldAnnotationReason - {-| An UNPACK pragma was applied to an abstract type in an indefinite package - in Backpack. + {-| An UNPACK pragma is unusable. + + A possible reason for this warning is that the UNPACK pragma was applied to + one of the following: + + * a function type @a -> b@ + * a recursive use of the data type being defined + * a sum type that cannot be unpacked, see @Note [UNPACK for sum types]@ + * a type/data family application with no matching instance in the environment + + However, it is deliberately /not/ emitted if: + + * the failure occurs in an indefinite package in Backpack + * the pragma is usable, but unpacking is disabled by @-O0@ Test cases: - unpack_sums_5, T3966, T7050 + unpack_sums_5, T3966, T7050, T25672, T23307c + + Negative test cases (must not trigger this warning): + T3990 -} - BackpackUnpackAbstractType :: BadFieldAnnotationReason + UnusableUnpackPragma :: BadFieldAnnotationReason deriving (Generic) data SuperclassCycle = ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -322,7 +322,7 @@ splice to separate the module and force the desired order of kind-checking: data D1 = MkD1 !(F Int) -- now (F Int) surely gets unpacked The current version of GHC is more predictable. Neither the (Complex Double) nor -the (F Int) example gets unpacking, the type/data instance is put into a +the (F Int) example gets unpacking unless the type/data instance is put into a separate HsGroup, either with $(return []) or by placing it in another module altogether. This is a direct result of placing instances after the other SCCs, as described in Note [Put instances at the end] in GHC.Rename.Module @@ -449,11 +449,20 @@ tcTyClGroupsPass all_gs thing_inside = go True ttcgs_zero mempty nilOL all_gs -- pass, the current group's lexical dependencies must have been -- satisfied by the preceding groups; no need for the ready check, -- this avoids some lookups in tcg_env + + -- See Note [Expedient use of diagnostics in tcTyClGroupsPass] + set_opts action + | strict = setWOptM Opt_WarnUnusableUnpackPragmas action + | otherwise = action + validate _ msgs _ + | strict = not (unpackErrorsFound msgs) + | otherwise = True + if not ready then return on_blocked else - tryTcDiscardingErrs' (\_ msgs _ -> not (strict && unpackErrorsFound msgs)) + tryTcDiscardingErrs' validate (return on_flawed) (return on_failed) - (on_success <$> tcTyClGroup g) + (on_success <$> set_opts (tcTyClGroup g)) data TcTyClGroupsStats = TcTyClGroupsStats @@ -479,15 +488,36 @@ instance Outputable TcTyClGroupsStats where , text "n_failed =" <+> ppr (ttcgs_n_failed stats) , text "n_flawed =" <+> ppr (ttcgs_n_flawed stats) ] +-- See Note [Expedient use of diagnostics in tcTyClGroupsPass] unpackErrorsFound :: Messages TcRnMessage -> Bool unpackErrorsFound = any is_unpack_error where is_unpack_error :: TcRnMessage -> Bool is_unpack_error (TcRnMessageWithInfo _ (TcRnMessageDetailed _ msg)) = is_unpack_error msg is_unpack_error (TcRnWithHsDocContext _ msg) = is_unpack_error msg - is_unpack_error (TcRnBadFieldAnnotation _ _ BackpackUnpackAbstractType) = True + is_unpack_error (TcRnBadFieldAnnotation _ _ UnusableUnpackPragma) = True is_unpack_error _ = False +{- Note [Expedient use of diagnostics in tcTyClGroupsPass] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In tcTyClGroupsPass.go with strict=True, we want to skip "flawed" groups, i.e. +groups with unusable unpack pragmas, as explained in Note [Retrying TyClGroups]. +To detect these unusable {-# UNPACK #-} pragmas, we currently piggy-back on the +diagnostics infrastructure: + + 1. (setWOptM Opt_WarnUnusableUnpackPragmas) to enable the warning. + The warning is on by default, but the user may have disabled it with + -Wno-unusable-unpack-pragmas, in which case we need to turn it back on. + + 2. (unpackErrorsFound msgs) to check if UnusableUnpackPragma is one of the + collected diagnostics. This is somewhat unpleasant because of the need to + recurse into TcRnMessageWithInfo and TcRnWithHsDocContext. + +Arguably, this is not a principled solution, because diagnostics are meant for +the user and here we inspect them to determine the order of type-checking. The +only reason for the current setup is that it was the easy thing to do. +-} + isReadyTyClGroup :: TcGblEnv -> TyClGroup GhcRn -> Bool isReadyTyClGroup tcg_env TyClGroup{group_ext = deps} = nameSetAll (\n -> n `elemNameEnv` tcg_type_env tcg_env) deps @@ -5123,7 +5153,7 @@ checkValidDataCon dflags existential_ok tc con -- warn in this case (it gives users the wrong idea about whether -- or not UNPACK on abstract types is supported; it is!) , isHomeUnitDefinite (hsc_home_unit hsc_env) - = addDiagnosticTc (bad_bang n BackpackUnpackAbstractType) + = addDiagnosticTc (bad_bang n UnusableUnpackPragma) | otherwise = return () ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -20,7 +20,8 @@ module GHC.Tc.Utils.Monad( updTopFlags, getEnvs, setEnvs, updEnvs, restoreEnvs, xoptM, doptM, goptM, woptM, - setXOptM, unsetXOptM, unsetGOptM, unsetWOptM, + setXOptM, setWOptM, + unsetXOptM, unsetGOptM, unsetWOptM, whenDOptM, whenGOptM, whenWOptM, whenXOptM, unlessXOptM, getGhcMode, @@ -579,6 +580,9 @@ woptM flag = wopt flag <$> getDynFlags setXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a setXOptM flag = updTopFlags (\dflags -> xopt_set dflags flag) +setWOptM :: WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a +setWOptM flag = updTopFlags (\dflags -> wopt_set dflags flag) + unsetXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a unsetXOptM flag = updTopFlags (\dflags -> xopt_unset dflags flag) ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -711,7 +711,7 @@ type family GhcDiagnosticCode c = n | n -> c where -- TcRnBadFieldAnnotation/BadFieldAnnotationReason GhcDiagnosticCode "LazyFieldsDisabled" = 81601 GhcDiagnosticCode "UnpackWithoutStrictness" = 10107 - GhcDiagnosticCode "BackpackUnpackAbstractType" = 40091 + GhcDiagnosticCode "UnusableUnpackPragma" = 40091 -- TcRnRoleValidationFailed/RoleInferenceFailedReason GhcDiagnosticCode "TyVarRoleMismatch" = 22221 ===================================== docs/users_guide/9.14.1-notes.rst ===================================== @@ -25,17 +25,6 @@ Language This deprecation is controlled by the newly introduced ``-Wdeprecated-pragmas`` flag in ``-Wdefault``. -* A new flag, ``-Wuseless-specialisations``, controls warnings emitted when GHC - determines that a SPECIALISE pragma would have no effect. - -* A new flag, ``-Wrule-lhs-equalities``, controls warnings emitted for RULES - whose left-hand side attempts to quantify over equality constraints that - previous GHC versions accepted quantifying over. GHC will now drop such RULES, - emitting a warning message controlled by this flag. - - This warning is intended to give visibility to the fact that the RULES that - previous GHC versions generated in such circumstances could never fire. - * ``-Wincomplete-record-selectors`` is now part of `-Wall`, as specified by `GHC Proposal 516: add warning for incomplete record selectors https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0516-in...`_. Hence, if a library is compiled with ``-Werror``, compilation may now fail. Solution: fix the library. @@ -93,6 +82,25 @@ Compiler :ghc-ticket:`20875`, :ghc-ticket:`21172`, :ghc-ticket:`22257`, :ghc-ticket:`25238`, :ghc-ticket:`25834`. +- A new flag, :ghc-flag:`-Wuseless-specialisations`, controls warnings emitted when GHC + determines that a SPECIALISE pragma would have no effect. + +- A new flag, :ghc-flag:`-Wrule-lhs-equalities`, controls warnings emitted for RULES + whose left-hand side attempts to quantify over equality constraints that + previous GHC versions accepted quantifying over. GHC will now drop such RULES, + emitting a warning message controlled by this flag. + + This warning is intended to give visibility to the fact that the RULES that + previous GHC versions generated in such circumstances could never fire. + +- A new flag, :ghc-flag:`-Wunusable-unpack-pragmas`, controls warnings emitted + when GHC is unable to unpack a data constructor field annotated by the + ``{-# UNPACK #-}`` pragma. + + Previous GHC versions issued this warning unconditionally. Now it is possible + to disable it with ``-Wno-unusable-unpack-pragmas`` or turn it into an error + with ``-Werror=unusable-unpack-pragmas``. + GHCi ~~~~ ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -84,6 +84,7 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Wnoncanonical-monad-instances` * :ghc-flag:`-Wdata-kinds-tc` * :ghc-flag:`-Wimplicit-rhs-quantification` + * :ghc-flag:`-Wunusable-unpack-pragmas` .. ghc-flag:: -W :shortdesc: enable normal warnings @@ -2646,6 +2647,40 @@ of ``-W(no-)*``. To make the code forwards-compatible and silence the warning, users are advised to add parentheses manually. +.. ghc-flag:: -Wunusable-unpack-pragmas + :shortdesc: warn when an ``{-# UNPACK #-}`` pragma is unusable + :type: dynamic + :reverse: -Wno-unusable-unpack-pragmas + + :since: 9.14.1 + :default: on + + Warn on unusable ``{-# UNPACK #-}`` pragmas in data type declarations. + Examples:: + + data T = MkT {-# UNPACK #-} !(Int -> Bool) + + data G where + MkG :: {-# UNPACK #-} !G -> G + + type family F a where {} + data R a = MkR { fld :: {-# UNPACK #-} !(F a) } + + A possible reason for this warning is that the ``{-# UNPACK #-}`` pragma was + applied to one of the following: + + * a function type ``a -> b`` + * a recursive use of the data type being defined + * a sum type that cannot be unpacked + * a type/data family application with no matching instance in the environment + + However, it is deliberately **not** emitted if: + + * the failure occurs in an indefinite package in Backpack + * the pragma is usable, but unpacking is disabled by :ghc-flag:`-O0` + +---- + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's sanity, not yours.) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -43,6 +43,11 @@ T3990b: '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T3990b.hs | grep 'test_case' # Grep output should show an unpacked constructor +T3990c: + $(RM) -f T3990c.o T3990c.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T3990c.hs | grep 'test_case' + # Grep output should show an unpacked constructor + T8848: $(RM) -f T8848.o T8848.hi '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-rule-firings T8848.hs | grep 'SPEC map2' ===================================== testsuite/tests/simplCore/should_compile/T23307c.stderr ===================================== @@ -1,5 +1,5 @@ - -T23307c.hs:7:13: warning: [GHC-40091] +T23307c.hs:7:13: warning: [GHC-40091] [-Wunusable-unpack-pragmas (in -Wdefault)] • Ignoring unusable UNPACK pragma on the first argument of ‘LCon’ • In the definition of data constructor ‘LCon’ In the data type declaration for ‘Loop’ + ===================================== testsuite/tests/simplCore/should_compile/T3990c.hs ===================================== @@ -0,0 +1,18 @@ +{-# OPTIONS -Wno-unusable-unpack-pragmas #-} + -- The warning is disabled, but this should not affect unpacking + +{-# LANGUAGE TypeFamilies #-} +module T3990c where + +type family F a + +data D1 = MkD1 {-# UNPACK #-} !(F Int) + -- This should actually get unpacked + +data D2 = MkD2 {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + +type instance F Int = D2 + +test_case :: D1 +test_case = MkD1 (MkD2 1 1) ===================================== testsuite/tests/simplCore/should_compile/T3990c.stdout ===================================== @@ -0,0 +1,2 @@ +test_case :: D1 +test_case = T3990c.MkD1 1# 1# ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -211,6 +211,7 @@ test('T11742', normal, compile, ['-O2']) test('T11644', normal, compile, ['-O2']) test('T3990', normal, makefile_test, ['T3990']) test('T3990b', normal, makefile_test, ['T3990b']) +test('T3990c', normal, makefile_test, ['T3990c']) test('T12076', [], multimod_compile, ['T12076', '-v0']) test('T12076lit', normal, compile, ['-O']) ===================================== testsuite/tests/simplCore/should_fail/T25672.stderr ===================================== @@ -1,4 +1,4 @@ -T25672.hs:12:7: warning: [GHC-40091] +T25672.hs:12:7: warning: [GHC-40091] [-Wunusable-unpack-pragmas (in -Wdefault)] • Ignoring unusable UNPACK pragma on the first argument of ‘WrapIntOrWord’ • In the definition of data constructor ‘WrapIntOrWord’ ===================================== testsuite/tests/typecheck/should_compile/T7050.stderr ===================================== @@ -1,5 +1,5 @@ - -T7050.hs:3:14: warning: [GHC-40091] +T7050.hs:3:14: warning: [GHC-40091] [-Wunusable-unpack-pragmas (in -Wdefault)] • Ignoring unusable UNPACK pragma on the first argument of ‘Foo’ • In the definition of data constructor ‘Foo’ In the data type declaration for ‘Foo’ + ===================================== testsuite/tests/typecheck/should_fail/T3966.stderr ===================================== @@ -1,5 +1,5 @@ - -T3966.hs:5:16: error: [GHC-40091] [-Werror] +T3966.hs:5:16: error: [GHC-40091] [-Wunusable-unpack-pragmas (in -Wdefault), Werror=unusable-unpack-pragmas] • Ignoring unusable UNPACK pragma on the first argument of ‘Foo’ • In the definition of data constructor ‘Foo’ In the data type declaration for ‘Foo’ + ===================================== testsuite/tests/typecheck/should_fail/T3966b.hs ===================================== @@ -0,0 +1,12 @@ +{-# OPTIONS -Werror=unusable-unpack-pragmas #-} +{-# LANGUAGE TypeFamilies #-} + +module T3966b where + +data T = MkT {-# UNPACK #-} !(Int -> Bool) + +data G where + MkG :: {-# UNPACK #-} !G -> G + +type family F a where {} +data R a = MkR { fld :: {-# UNPACK #-} !(F a) } ===================================== testsuite/tests/typecheck/should_fail/T3966b.stderr ===================================== @@ -0,0 +1,15 @@ +T3966b.hs:6:10: error: [GHC-40091] [-Wunusable-unpack-pragmas (in -Wdefault), Werror=unusable-unpack-pragmas] + • Ignoring unusable UNPACK pragma on the first argument of ‘MkT’ + • In the definition of data constructor ‘MkT’ + In the data type declaration for ‘T’ + +T3966b.hs:9:3: error: [GHC-40091] [-Wunusable-unpack-pragmas (in -Wdefault), Werror=unusable-unpack-pragmas] + • Ignoring unusable UNPACK pragma on the first argument of ‘MkG’ + • In the definition of data constructor ‘MkG’ + In the data type declaration for ‘G’ + +T3966b.hs:12:12: error: [GHC-40091] [-Wunusable-unpack-pragmas (in -Wdefault), Werror=unusable-unpack-pragmas] + • Ignoring unusable UNPACK pragma on the first argument of ‘MkR’ + • In the definition of data constructor ‘MkR’ + In the data type declaration for ‘R’ + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -213,6 +213,7 @@ test('T3613', normal, compile_fail, ['']) test('fd-loop', normal, compile_fail, ['']) test('T3950', normal, compile_fail, ['']) test('T3966', normal, compile_fail, ['']) +test('T3966b', normal, compile_fail, ['']) test('IPFail', normal, compile_fail, ['']) test('T3468', [], multimod_compile_fail, ['T3468', '-v0']) ===================================== testsuite/tests/unboxedsums/unpack_sums_5.stderr ===================================== @@ -1,10 +1,10 @@ - -unpack_sums_5.hs:4:22: warning: [GHC-40091] +unpack_sums_5.hs:4:22: warning: [GHC-40091] [-Wunusable-unpack-pragmas (in -Wdefault)] • Ignoring unusable UNPACK pragma on the first argument of ‘JustT’ • In the definition of data constructor ‘JustT’ In the data type declaration for ‘SMaybeT’ -unpack_sums_5.hs:7:10: warning: [GHC-40091] +unpack_sums_5.hs:7:10: warning: [GHC-40091] [-Wunusable-unpack-pragmas (in -Wdefault)] • Ignoring unusable UNPACK pragma on the first argument of ‘MkT’ • In the definition of data constructor ‘MkT’ In the data type declaration for ‘T’ + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a83bbd1152bf3eb76c21ab60c2a1631f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a83bbd1152bf3eb76c21ab60c2a1631f... You're receiving this email because of your account on gitlab.haskell.org.