[Git][ghc/ghc][wip/9.6.4-backports] 2 commits: Cpr: Turn an assertion into a check to deal with some dead code (#23862)
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Fri Dec 15 14:56:27 UTC 2023
Zubin pushed to branch wip/9.6.4-backports at Glasgow Haskell Compiler / GHC
Commits:
1405682a by Sebastian Graf at 2023-12-15T19:51:47+05:30
Cpr: Turn an assertion into a check to deal with some dead code (#23862)
See the new `Note [Dead code may contain type confusions]`.
Fixes #23862.
(cherry picked from commit 57c391c463f26b7025df9b340ad98416cff1d2b2)
- - - - -
dfd28f7a by Zubin Duggal at 2023-12-15T20:26:10+05:30
Prepare release 9.6.4
- - - - -
6 changed files:
- compiler/GHC/Core/Opt/CprAnal.hs
- configure.ac
- + docs/users_guide/9.6.4-notes.rst
- docs/users_guide/release-notes.rst
- + testsuite/tests/cpranal/should_compile/T23862.hs
- testsuite/tests/cpranal/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/CprAnal.hs
=====================================
@@ -35,7 +35,6 @@ import GHC.Data.Graph.UnVar -- for UnVarSet
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
-import GHC.Utils.Panic.Plain
import GHC.Utils.Logger ( Logger, putDumpFileMaybe, DumpFormat (..) )
import Data.List ( mapAccumL )
@@ -271,11 +270,11 @@ cprAnalAlt
cprAnalAlt env scrut_ty (Alt con bndrs rhs)
= (rhs_ty, Alt con bndrs rhs')
where
+ ids = filter isId bndrs
env_alt
| DataAlt dc <- con
- , let ids = filter isId bndrs
, CprType arity cpr <- scrut_ty
- , assert (arity == 0 ) True
+ , arity == 0 -- See Note [Dead code may contain type confusions]
= case unpackConFieldsCpr dc cpr of
AllFieldsSame field_cpr
| let sig = mkCprSig 0 field_cpr
@@ -284,7 +283,7 @@ cprAnalAlt env scrut_ty (Alt con bndrs rhs)
| let sigs = zipWith (mkCprSig . idArity) ids field_cprs
-> extendSigEnvList env (zipEqual "cprAnalAlt" ids sigs)
| otherwise
- = env
+ = extendSigEnvAllSame env ids topCprSig
(rhs_ty, rhs') = cprAnal env_alt rhs
--
@@ -431,6 +430,43 @@ cprFix orig_env orig_pairs
(id', rhs', env') = cprAnalBind env id rhs
{-
+Note [Dead code may contain type confusions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In T23862, we have a nested case match that looks like this
+
+ data CheckSingleton (check :: Bool) where
+ Checked :: CheckSingleton True
+ Unchecked :: CheckSingleton False
+ data family Result (check :: Bool) a
+ data instance Result True a = CheckedResult a
+ newtype instance Result True a = UncheckedResult a
+
+ case m () of Checked co1 ->
+ case m () of Unchecked co2 ->
+ case ((\_ -> True)
+ |> .. UncheckedResult ..
+ |> sym co2
+ |> co1) :: Result True (Bool -> Bool) of
+ CheckedResult f -> CheckedResult (f True)
+
+Clearly, the innermost case is dead code, because the `Checked` and `Unchecked`
+cases are apart.
+However, both constructors introduce mutually contradictory coercions `co1` and
+`co2` along which GHC generates a type confusion:
+
+ 1. (\_ -> True) :: Bool -> Bool
+ 2. newtype coercion UncheckedResult (\_ -> True) :: Result False (Bool -> Bool)
+ 3. |> ... sym co1 ... :: Result check (Bool -> Bool)
+ 4. |> ... co2 ... :: Result True (Bool -> Bool)
+
+Note that we started with a function, injected into `Result` via a newtype
+instance and then match on it with a datatype instance.
+
+We have to handle this case gracefully in `cprAnalAlt`, where for the innermost
+case we see a `DataAlt` for `CheckedResult`, yet have a scrutinee type that
+abstracts the function `(\_ -> True)` with arity 1.
+In this case, don't pretend we know anything about the fields of `CheckedResult`!
+
Note [The OPAQUE pragma and avoiding the reboxing of results]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider:
=====================================
configure.ac
=====================================
@@ -13,7 +13,7 @@ dnl
# see what flags are available. (Better yet, read the documentation!)
#
-AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.3], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
+AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.4], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
# Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable
# to be useful (cf #19058). However, the version must have three components
# (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are
@@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.3], [glasgow-has
AC_CONFIG_MACRO_DIRS([m4])
# Set this to YES for a released version, otherwise NO
-: ${RELEASE=NO}
+: ${RELEASE=YES}
# The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
# above. If this is not a released version, then we will append the
=====================================
docs/users_guide/9.6.4-notes.rst
=====================================
@@ -0,0 +1,123 @@
+.. _release-9-6-4:
+
+Version 9.6.4
+==============
+
+The significant changes to the various parts of the compiler are listed below.
+See the `migration guide
+<https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.6>`_ on the GHC Wiki
+for specific guidance on migrating programs to this release.
+
+The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM
+11, 12, 13, 14 or 15.
+
+Significant Changes
+~~~~~~~~~~~~~~~~~~~~
+
+Issues fixed in this release include:
+
+Compiler
+--------
+
+- Fix a code generator bug on AArch64 platforms resulting in invalid conditional
+ jumps (:ghc-ticket:`23746`).
+- Fix a simplifier bug that may cause segfaults and core lint failures due to
+ incorrect handling of join points (:ghc-ticket:`23952`).
+- Ensure unconstrained instance dictionaries get IPE info (:ghc-ticket:`24005`).
+- Fix a bug where we could silently truncate 64 bit values to 32 bit on
+ 32 bit architectures.
+- Fix a GHCi bug where a failure in the ``:add`` command would cause the
+ process to exit (:ghc-ticket:`24115`).
+- Fix a bug causing suboptimal error messages for certain invalid cyclic
+ module graphs with hs-boot files (:ghc-ticket:`24196`).
+- Fix a bug causing compiler panics with certain package databases involving
+ unusable units and module reexports (:ghc-ticket:`21097`, :ghc-ticket:`16996`,
+ :ghc-ticket:`11050`).
+- Fix some memory leaks in GHCi that manifest on reloads (:ghc-ticket:`24107`,
+ :ghc-ticket:`24118`).
+- Fix a bug leading to some template haskell splices failing on being reloaded
+ into GHCi due to not clearing the interactive context properly
+ (:ghc-ticket:`23405`).
+- Fix a type checker crash on certain programs involving implicitly scoped type
+ variables (:ghc-ticket:`24083`).
+- Fix a bug where certain warning flags were not recognised (:ghc-ticket:`24071`).
+- Fix an incorrect assertion in the simplifier (:ghc-ticket:`23862`).
+
+Runtime system
+--------------
+
+- Ensure concurrent thunk update is sound (:ghc-ticket:`23185`).
+- Ensure the ``listAllBlocks`` function takes the non-moving heap into account
+ (:ghc-ticket:`22627`).
+- Ensure the non-moving GC is not running when pausing
+- Fix some non-moving loops and bugs on Windows and LLP64 platforms
+ (:ghc-ticket:`23003`, :ghc-ticket:`24042`).
+- Fix a bug where certain programs could have incorrect async exception masking
+ (:ghc-ticket:`23513`).
+- Ensure we respect maximum event length and don't overflow into program
+ memory (:ghc-ticket:`24197`).
+
+Build system and packaging
+--------------------------
+
+- Ensure we use the right linker flags on AArch64 darwin (:ghc-ticket:`21712`,
+ :ghc-ticket:`24033`).
+- Fix a bug where ``-DNOSMP`` wasn't being passed to the C compiler even if the
+ target doesn't support SMP (:ghc-ticket:`24082`).
+
+Core libraries
+--------------
+
+- Fix a bug in ghc-bignum where usage of `bigNatIsPowerOf2` might result in
+ out of bounds access (:ghc-ticket:`24066`).
+- Bump ``base`` to 4.18.2.0
+- base: Update to Unicode 15.1.0
+- Bump ``filepath`` to 1.4.200.1
+- Bump ``unix`` to 2.8.4.0
+- Bump ``haddock`` to 2.29.2
+
+Included libraries
+------------------
+
+The package database provided with this distribution also contains a number of
+packages other than GHC itself. See the changelogs provided with these packages
+for further change information.
+
+.. ghc-package-list::
+
+ libraries/array/array.cabal: Dependency of ``ghc`` library
+ libraries/base/base.cabal: Core library
+ libraries/binary/binary.cabal: Dependency of ``ghc`` library
+ libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library
+ libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library
+ libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library
+ libraries/directory/directory.cabal: Dependency of ``ghc`` library
+ libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library
+ libraries/filepath/filepath.cabal: Dependency of ``ghc`` library
+ compiler/ghc.cabal: The compiler itself
+ libraries/ghci/ghci.cabal: The REPL interface
+ libraries/ghc-boot/ghc-boot.cabal: Internal compiler library
+ libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library
+ libraries/ghc-compact/ghc-compact.cabal: Core library
+ libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library
+ libraries/ghc-prim/ghc-prim.cabal: Core library
+ libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable
+ libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable
+ libraries/integer-gmp/integer-gmp.cabal: Core library
+ libraries/libiserv/libiserv.cabal: Internal compiler library
+ libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
+ libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
+ libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
+ libraries/process/process.cabal: Dependency of ``ghc`` library
+ libraries/stm/stm.cabal: Dependency of ``haskeline`` library
+ libraries/template-haskell/template-haskell.cabal: Core library
+ libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library
+ libraries/text/text.cabal: Dependency of ``Cabal`` library
+ libraries/time/time.cabal: Dependency of ``ghc`` library
+ libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
+ libraries/unix/unix.cabal: Dependency of ``ghc`` library
+ libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
+ libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
+
=====================================
docs/users_guide/release-notes.rst
=====================================
@@ -7,3 +7,4 @@ Release notes
9.6.1-notes
9.6.2-notes
9.6.3-notes
+ 9.6.4-notes
=====================================
testsuite/tests/cpranal/should_compile/T23862.hs
=====================================
@@ -0,0 +1,29 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GADTs #-}
+module T23862 where
+
+data Checked
+data Unchecked
+
+data family Result check a
+data instance Result Checked a = CheckedResult a
+newtype instance Result Unchecked a = UncheckedResult a
+
+data CheckSingleton check where
+ Checked :: CheckSingleton Checked
+ Unchecked :: CheckSingleton Unchecked
+
+und :: Bool -> Bool
+und x = und x
+
+app :: forall check. (() -> CheckSingleton check) -> Result check Bool
+app m = let f :: Result check (Bool -> Bool)
+ f = case m () of
+ Checked -> CheckedResult und
+ Unchecked -> UncheckedResult und
+ in case m () of
+ Checked -> case f of
+ CheckedResult x -> CheckedResult (x True)
+ Unchecked -> UncheckedResult True
=====================================
testsuite/tests/cpranal/should_compile/all.T
=====================================
@@ -22,3 +22,5 @@ test('T18401', [ grep_errmsg(r'^T18401\.\S+ ::') ], compile, ['-ddump-simpl -dsu
test('T18824', [ grep_errmsg(r'JoinId[^\n]*Cpr') ], compile, ['-ddump-exitify -dppr-cols=1000 -dsuppress-uniques'])
test('T20539', [], compile, ['']) # simply should not crash
+
+test('T23862', [], compile, ['']) # simply should not crash
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ac485d289569dbed00a764f07ed388d41a563f6...dfd28f7a0ab6dc6fe2b946f562e84aa160b41657
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ac485d289569dbed00a764f07ed388d41a563f6...dfd28f7a0ab6dc6fe2b946f562e84aa160b41657
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/20231215/8a5d3fb6/attachment-0001.html>
More information about the ghc-commits
mailing list