[Git][ghc/ghc][wip/backports-9.8] 6 commits: Fix MultiWayIf linearity checking (#23814)
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Thu Sep 14 00:06:58 UTC 2023
Ben Gamari pushed to branch wip/backports-9.8 at Glasgow Haskell Compiler / GHC
Commits:
ae38fa41 by Krzysztof Gogolewski at 2023-09-13T18:04:04-04:00
Fix MultiWayIf linearity checking (#23814)
Co-authored-by: Thomas BAGREL <thomas.bagrel at tweag.io>
(cherry picked from commit edd8bc43566b3f002758e5d08c399b6f4c3d7443)
- - - - -
89f6bc6d by Ben Gamari at 2023-09-13T18:05:35-04:00
base: Don't use Data.ByteString.Internals.memcpy
This function is now deprecated from `bytestring`. Use
`Foreign.Marshal.Utils.copyBytes` instead.
Fixes #23880.
(cherry picked from commit 6ccd9d657b33bc6237d8e046ca3b07c803645130)
- - - - -
da5121f6 by Alexander Esgen at 2023-09-13T18:05:59-04:00
users-guide: remove note about fatal Haddock parse failures
(cherry picked from commit a05cdaf018688491625066c0041a4686301d4bc2)
- - - - -
5559e59e by Ben Gamari at 2023-09-13T18:36:33-04:00
Introduce GHC.Rename.Utils.delLocalNames
- - - - -
00dcc7d9 by Ben Gamari at 2023-09-13T18:36:33-04:00
Introduce GHC.Types.Name.Reader.minusLocalRdrEnvList
- - - - -
01236c2f by sheaf at 2023-09-13T18:38:14-04:00
Remove ScopedTypeVariables => TypeAbstractions
This commit implements [amendment 604](https://github.com/ghc-proposals/ghc-proposals/pull/604/)
to [GHC proposal 448](https://github.com/ghc-proposals/ghc-proposals/pull/448)
by removing the implication of language extensions
ScopedTypeVariables => TypeAbstractions
To limit breakage, we now allow type arguments in constructor patterns
when both ScopedTypeVariables and TypeApplications are enabled, but
we emit a warning notifying the user that this is deprecated behaviour
that will go away starting in GHC 9.12.
Fixes #23776
(cherry picked from commit 9eecdf33864ddfaa4a6489227ea29a16f7ffdd44)
- - - - -
18 changed files:
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/StgToCmm/InfoTableProv.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Name/Reader.hs
- docs/users_guide/using.rst
- + testsuite/tests/linear/should_compile/T23814.hs
- testsuite/tests/linear/should_compile/all.T
- + testsuite/tests/linear/should_fail/T23814fail.hs
- + testsuite/tests/linear/should_fail/T23814fail.stderr
- testsuite/tests/linear/should_fail/all.T
- + testsuite/tests/typecheck/should_fail/T23776.hs
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -1418,7 +1418,6 @@ languageExtensions (Just GHC2021)
LangExt.PostfixOperators,
LangExt.RankNTypes,
LangExt.ScopedTypeVariables,
- LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables"
LangExt.StandaloneDeriving,
LangExt.StandaloneKindSignatures,
LangExt.TupleSections,
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2797,9 +2797,6 @@ impliedXFlags
, (LangExt.MultiParamTypeClasses, turnOn, LangExt.ConstrainedClassMethods) -- c.f. #7854
, (LangExt.TypeFamilyDependencies, turnOn, LangExt.TypeFamilies)
- -- In accordance with GHC Proposal #448 "Modern Scoped Type Variables"
- , (LangExt.ScopedTypeVariables, turnOn, LangExt.TypeAbstractions)
-
, (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off!
, (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies)
=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -1,3 +1,4 @@
+
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -6,7 +7,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
-
+{-# LANGUAGE MultiWayIf #-}
{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
@@ -642,9 +643,26 @@ rnConPatAndThen mk con (PrefixCon tyargs pats)
where
check_lang_exts :: RnM ()
check_lang_exts =
- unlessXOptM LangExt.TypeAbstractions $
- for_ (listToMaybe tyargs) $ \ arg ->
- addErrTc $ TcRnTypeApplicationsDisabled (TypeApplicationInPattern arg)
+ for_ (listToMaybe tyargs) $ \ arg ->
+ do { type_abs <- xoptM LangExt.TypeAbstractions
+ ; type_app <- xoptM LangExt.TypeApplications
+ ; scoped_tvs <- xoptM LangExt.ScopedTypeVariables
+ ; if | type_abs
+ -> return ()
+
+ -- As per [GHC Proposal 604](https://github.com/ghc-proposals/ghc-proposals/pull/604/),
+ -- we allow type applications in constructor patterns when -XTypeApplications and
+ -- -XScopedTypeVariables are both enabled, but we emit a warning when doing so.
+ --
+ -- This warning is scheduled to become an error in GHC 9.12, in
+ -- which case we will get the usual error (below),
+ -- which suggests enabling -XTypeAbstractions.
+ | type_app && scoped_tvs
+ -> addDiagnostic TcRnDeprecatedInvisTyArgInConPat
+
+ | otherwise
+ -> addErrTc $ TcRnTypeApplicationsDisabled (TypeApplicationInPattern arg)
+ }
rnConPatTyArg (HsConPatTyArg at t) = do
t' <- liftCpsWithCont $ rnHsPatSigTypeBindingVars HsTypeCtx t
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -26,7 +26,7 @@ module GHC.Rename.Utils (
newLocalBndrRn, newLocalBndrsRn,
- bindLocalNames, bindLocalNamesFV,
+ bindLocalNames, bindLocalNamesFV, delLocalNames,
addNameClashErrRn, mkNameClashErr,
@@ -108,6 +108,14 @@ bindLocalNamesFV names enclosed_scope
= do { (result, fvs) <- bindLocalNames names enclosed_scope
; return (result, delFVs names fvs) }
+delLocalNames :: [Name] -> RnM a -> RnM a
+delLocalNames names
+ = updLclCtxt $ \ lcl_env ->
+ let th_bndrs' = delListFromNameEnv (tcl_th_bndrs lcl_env) names
+ rdr_env' = minusLocalRdrEnvList (tcl_rdr lcl_env) (map occName names)
+ in lcl_env { tcl_th_bndrs = th_bndrs'
+ , tcl_rdr = rdr_env' }
+
-------------------------------------
checkDupRdrNames :: [LocatedN RdrName] -> RnM ()
-- Check for duplicated names in a binding group
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -6,6 +6,7 @@ import Foreign
#if defined(HAVE_LIBZSTD)
import Foreign.C.Types
+import Foreign.Marshal.Utils (copyBytes)
import qualified Data.ByteString.Internal as BSI
import GHC.IO (unsafePerformIO)
#endif
@@ -274,7 +275,7 @@ compress clvl (BSI.PS srcForeignPtr off len) = unsafePerformIO $
(srcPtr `plusPtr` off)
(fromIntegral len)
(fromIntegral clvl)
- BSI.create compressedSize $ \p -> BSI.memcpy p dstPtr compressedSize
+ BSI.create compressedSize $ \p -> copyBytes p dstPtr compressedSize
foreign import ccall unsafe "ZSTD_compress"
zstd_compress ::
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1824,6 +1824,11 @@ instance Diagnostic TcRnMessage where
text "whereas" <+> quotes (text "forall {a}.") <+> text "and" <+> quotes (text "forall a ->") <+> text "do not."
]]
+ TcRnDeprecatedInvisTyArgInConPat ->
+ mkSimpleDecorated $
+ cat [ text "Type applications in constructor patterns will require"
+ , text "the TypeAbstractions extension starting from GHC 9.12." ]
+
TcRnInvisBndrWithoutSig _ hs_bndr ->
mkSimpleDecorated $
vcat [ hang (text "Invalid invisible type variable binder:")
@@ -2427,6 +2432,8 @@ instance Diagnostic TcRnMessage where
-> WarningWithFlag Opt_WarnMissingRoleAnnotations
TcRnIllegalInvisTyVarBndr{}
-> ErrorWithoutFlag
+ TcRnDeprecatedInvisTyArgInConPat {}
+ -> WarningWithoutFlag
TcRnInvalidInvisTyVarBndr{}
-> ErrorWithoutFlag
TcRnInvisBndrWithoutSig{}
@@ -3072,6 +3079,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnIllegalInvisTyVarBndr{}
-> [suggestExtension LangExt.TypeAbstractions]
+ TcRnDeprecatedInvisTyArgInConPat{}
+ -> [suggestExtension LangExt.TypeAbstractions]
TcRnInvalidInvisTyVarBndr{}
-> noHints
TcRnInvisBndrWithoutSig name _
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -3080,6 +3080,15 @@ data TcRnMessage where
-> !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn)
-> TcRnMessage
+ {-| TcRnDeprecatedInvisTyArgInConPat is a warning that triggers on type applications
+ in constructor patterns when the user has not enabled '-XTypeAbstractions'
+ but instead has enabled both '-XScopedTypeVariables' and '-XTypeApplications'.
+
+ This warning is a deprecation mechanism that is scheduled until GHC 9.12.
+ -}
+ TcRnDeprecatedInvisTyArgInConPat
+ :: TcRnMessage
+
{-| TcRnLoopySuperclassSolve is a warning, controlled by @-Wloopy-superclass-solve@,
that is triggered when GHC solves a constraint in a possibly-loopy way,
violating the class instance termination rules described in the section
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -403,9 +403,34 @@ tcExpr (HsIf x pred b1 b2) res_ty
; tcEmitBindingUsage (supUE u1 u2)
; return (HsIf x pred' b1' b2') }
+{-
+Note [MultiWayIf linearity checking]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we'd like to compute the usage environment for
+
+if | b1 -> e1
+ | b2 -> e2
+ | otherwise -> e3
+
+and let u1, u2, v1, v2, v3 denote the usage env for b1, b2, e1, e2, e3
+respectively.
+
+Since a multi-way if is mere sugar for nested if expressions, the usage
+environment should ideally be u1 + sup(v1, u2 + sup(v2, v3)).
+However, currently we don't support linear guards (#19193). All variables
+used in guards from u1 and u2 will have multiplicity Many.
+But in that case, we have equality u1 + sup(x,y) = sup(u1 + x, y),
+ and likewise u2 + sup(x,y) = sup(u2 + x, y) for any x,y.
+Using this identity, we can just compute sup(u1 + v1, u2 + v2, v3) instead.
+This is simple to do, since we get u_i + v_i directly from tcGRHS.
+If we add linear guards, this code will have to be revisited.
+Not using 'sup' caused #23814.
+-}
+
tcExpr (HsMultiIf _ alts) res_ty
- = do { alts' <- mapM (wrapLocMA $ tcGRHS match_ctxt res_ty) alts
+ = do { (ues, alts') <- mapAndUnzipM (\alt -> tcCollectingUsage $ wrapLocMA (tcGRHS match_ctxt res_ty) alt) alts
; res_ty <- readExpType res_ty
+ ; tcEmitBindingUsage (supUEs ues) -- See Note [MultiWayIf linearity checking]
; return (HsMultiIf res_ty alts') }
where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody }
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -580,6 +580,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382
GhcDiagnosticCode "TcRnBadTyConTelescope" = 87279
GhcDiagnosticCode "TcRnPatersonCondFailure" = 22979
+ GhcDiagnosticCode "TcRnDeprecatedInvisTyArgInConPat" = 69797
-- TcRnTypeApplicationsDisabled
GhcDiagnosticCode "TypeApplication" = 23482
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -45,7 +45,7 @@ module GHC.Types.Name.Reader (
LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
lookupLocalRdrEnv, lookupLocalRdrOcc,
elemLocalRdrEnv, inLocalRdrEnvScope,
- localRdrEnvElts, minusLocalRdrEnv,
+ localRdrEnvElts, minusLocalRdrEnv, minusLocalRdrEnvList,
-- * Global mapping of 'RdrName' to 'GlobalRdrElt's
GlobalRdrEnvX, GlobalRdrEnv, IfGlobalRdrEnv,
@@ -486,6 +486,10 @@ minusLocalRdrEnv :: LocalRdrEnv -> OccEnv a -> LocalRdrEnv
minusLocalRdrEnv lre@(LRE { lre_env = env }) occs
= lre { lre_env = minusOccEnv env occs }
+minusLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
+minusLocalRdrEnvList lre@(LRE { lre_env = env }) occs
+ = lre { lre_env = delListFromOccEnv env occs }
+
{-
Note [Local bindings with Exact Names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/using.rst
=====================================
@@ -1768,8 +1768,8 @@ Haddock
top-level type-signature. With this flag GHC will parse Haddock comments
and include them in the interface file it produces.
- Note that this flag makes GHC's parser more strict so programs which are
- accepted without Haddock may be rejected with :ghc-flag:`-haddock`.
+ Consider using :ghc-flag:`-Winvalid-haddock` to be informed about discarded
+ documentation comments.
Miscellaneous flags
-------------------
=====================================
testsuite/tests/linear/should_compile/T23814.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE MultiWayIf #-}
+
+module T23814 where
+
+f :: Bool -> Int %1 -> Int
+f b x =
+ if
+ | b -> x
+ | otherwise -> x
+
+g :: Bool -> Bool -> Int %1 -> Int %1 -> (Int, Int)
+g b c x y =
+ if
+ | b -> (x,y)
+ | c -> (y,x)
+ | otherwise -> (x,y)
=====================================
testsuite/tests/linear/should_compile/all.T
=====================================
@@ -42,3 +42,4 @@ test('T20023', normal, compile, [''])
test('T22546', normal, compile, [''])
test('T23025', normal, compile, ['-dlinear-core-lint'])
test('LinearRecUpd', normal, compile, [''])
+test('T23814', normal, compile, [''])
=====================================
testsuite/tests/linear/should_fail/T23814fail.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE MultiWayIf #-}
+
+module T23814fail where
+
+f' :: Bool -> Int %1 -> Int
+f' b x =
+ if
+ | b -> x
+ | otherwise -> 0
+
+g' :: Bool -> Bool -> Int %1 -> Int
+g' b c x =
+ if
+ | b -> x
+ | c -> 0
+ | otherwise -> 0
=====================================
testsuite/tests/linear/should_fail/T23814fail.stderr
=====================================
@@ -0,0 +1,17 @@
+
+T23814fail.hs:7:6: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘f'’:
+ f' b x
+ = if | b -> x
+ | otherwise -> 0
+
+T23814fail.hs:13:8: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘g'’:
+ g' b c x
+ = if | b -> x
+ | c -> 0
+ | otherwise -> 0
=====================================
testsuite/tests/linear/should_fail/all.T
=====================================
@@ -41,3 +41,4 @@ test('T19120', normal, compile_fail, [''])
test('T20083', normal, compile_fail, ['-XLinearTypes'])
test('T19361', normal, compile_fail, [''])
test('T21278', normal, compile_fail, ['-XLinearTypes'])
+test('T23814fail', normal, compile_fail, [''])
=====================================
testsuite/tests/typecheck/should_fail/T23776.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE GHC2021 #-}
+
+module T23776 where
+
+import Data.Kind
+
+foo :: Maybe a -> Maybe a
+foo (Just @b x) = Just @b x
+foo _ = Nothing
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -697,3 +697,4 @@ test('VisFlag3', normal, compile_fail, [''])
test('VisFlag4', normal, compile_fail, [''])
test('VisFlag5', normal, compile_fail, [''])
test('T22684', normal, compile_fail, [''])
+test('T23776', normal, compile, ['']) # to become an error in GHC 9.12
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eee6be4040c03327db76986c4ef4c83e7f700954...01236c2f266697d7582397775702e98da9cd9a16
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eee6be4040c03327db76986c4ef4c83e7f700954...01236c2f266697d7582397775702e98da9cd9a16
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230913/bbf269df/attachment-0001.html>
More information about the ghc-commits
mailing list