[Git][ghc/ghc][wip/mp-9.2.5-backports] 2 commits: Attemp fix for core lint failures
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Wed Nov 2 12:23:41 UTC 2022
Zubin pushed to branch wip/mp-9.2.5-backports at Glasgow Haskell Compiler / GHC
Commits:
7c46d2ab by Zubin Duggal at 2022-11-01T15:04:48+05:30
Attemp fix for core lint failures
For an expression:
joinrec foo = ... in expr
we compute the arityType as `foldr andArityType (arityType expr) [arityType foo]`
which is the same as `andArityType (arityType expr) (arityType foo)`. However,
this is incorrect:
joinrec go x = ... in go 0
then the arity of go is 1 (\?. T), but the arity of the overall expression is
0 (_|_). `andArityType` however returns (\?. T) for these, which is wrong.
(cherry picked from commit 53235edd478bd4c5e29e4f254ce02559af259dd5)
- - - - -
040b8072 by Zubin Duggal at 2022-11-02T17:53:29+05:30
Bump base to 4.16.4.0 and add release notes
- - - - -
19 changed files:
- compiler/GHC/Core/Opt/Arity.hs
- configure.ac
- docs/users_guide/release-notes.rst
- libraries/base/base.cabal
- libraries/base/changelog.md
- + testsuite/tests/arityanal/should_compile/Arity17.hs
- testsuite/tests/arityanal/should_compile/all.T
- testsuite/tests/dependent/should_compile/T14729.stderr
- testsuite/tests/dependent/should_compile/T15743.stderr
- testsuite/tests/dependent/should_compile/T15743e.stderr
- testsuite/tests/indexed-types/should_compile/T15711.stderr
- testsuite/tests/indexed-types/should_compile/T15852.stderr
- testsuite/tests/polykinds/T15592.stderr
- testsuite/tests/polykinds/T15592b.stderr
- testsuite/tests/printer/T18052a.stderr
- testsuite/tests/roles/should_compile/T8958.stderr
- testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
- testsuite/tests/typecheck/should_compile/T12763.stderr
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
Changes:
=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -1104,22 +1104,6 @@ arityType env (Let (NonRec b r) e)
cheap_rhs = myExprIsCheap env r (Just (idType b))
env' = extendSigEnv env b (arityType env r)
-arityType env (Let (Rec pairs) body)
- | ((j,_):_) <- pairs
- , isJoinId j
- = -- See Note [arityType for join bindings]
- foldr (andArityType env . do_one) (arityType rec_env body) pairs
- where
- rec_env = foldl add_bot env pairs
- add_bot env (j,_) = extendSigEnv env j botArityType
-
- do_one :: (JoinId, CoreExpr) -> ArityType
- do_one (j,rhs)
- | Just arity <- isJoinId_maybe j
- = arityType rec_env $ snd $ collectNBinders arity rhs
- | otherwise
- = pprPanic "arityType:joinrec" (ppr pairs)
-
arityType env (Let (Rec prs) e)
= floatIn (all is_cheap prs) (arityType env' e)
where
=====================================
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.2.4], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
+AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.5], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
# Version on HEAD must be X.Y (not X.Y.Z) for ProjectVersionMunged variable
# to be useful (cf #19058)
=====================================
docs/users_guide/release-notes.rst
=====================================
@@ -8,3 +8,4 @@ Release notes
9.2.2-notes
9.2.3-notes
9.2.4-notes
+ 9.2.5-notes
=====================================
libraries/base/base.cabal
=====================================
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: base
-version: 4.16.3.0
+version: 4.16.4.0
-- NOTE: Don't forget to update ./changelog.md
license: BSD-3-Clause
=====================================
libraries/base/changelog.md
=====================================
@@ -1,5 +1,13 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
+## 4.16.4.0 *Nov 2022*
+
+ * Shipped with GHC 9.2.5
+
+ * Fix races in IOManager (setNumCapabilities,closeFdWith) (#21651)
+
+ * winio: do not re-translate input when handle is uncooked
+
## 4.16.3.0 *May 2022*
* Shipped with GHC 9.2.4
=====================================
testsuite/tests/arityanal/should_compile/Arity17.hs
=====================================
@@ -0,0 +1,27 @@
+module Bug (downsweep) where
+
+import GHC.Utils.Misc ( filterOut )
+import qualified Data.Map.Strict as M ( Map, elems )
+import qualified Data.Map as Map ( fromListWith )
+
+type DownsweepCache = M.Map Int Int
+
+downsweep :: [Int] -> IO DownsweepCache
+downsweep rootSummariesOk = do
+ let root_map = mkRootMap rootSummariesOk
+ checkDuplicates root_map
+ return root_map
+ where
+ checkDuplicates :: DownsweepCache -> IO ()
+ checkDuplicates root_map = multiRootsErr dup_roots
+ where
+ dup_roots = filterOut (>2) (M.elems root_map)
+
+mkRootMap
+ :: [Int]
+ -> DownsweepCache
+mkRootMap summaries = Map.fromListWith const
+ [ (s, s) | s <- summaries ]
+
+multiRootsErr :: [a] -> IO ()
+multiRootsErr [] = pure ()
=====================================
testsuite/tests/arityanal/should_compile/all.T
=====================================
@@ -16,6 +16,7 @@ test('Arity13', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dn
test('Arity14', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])
test('Arity15', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])
test('Arity16', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])
+test('Arity17', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-package ghc -dcore-lint -O2'])
# Regression tests
test('T18793', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])
=====================================
testsuite/tests/dependent/should_compile/T14729.stderr
=====================================
@@ -11,4 +11,4 @@ COERCION AXIOMS
FAMILY INSTANCES
type instance F Int = Bool -- Defined at T14729.hs:10:15
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
=====================================
testsuite/tests/dependent/should_compile/T15743.stderr
=====================================
@@ -3,4 +3,4 @@ TYPE CONSTRUCTORS
forall {k1} k2 (k3 :: k2). Proxy k3 -> k1 -> k2 -> *
roles nominal nominal nominal phantom phantom phantom
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
=====================================
testsuite/tests/dependent/should_compile/T15743e.stderr
=====================================
@@ -54,4 +54,4 @@ DATA CONSTRUCTORS
(d :: Proxy k5) (e :: Proxy k7).
f c -> T k8 a b f c d e
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
=====================================
testsuite/tests/indexed-types/should_compile/T15711.stderr
=====================================
@@ -3,4 +3,4 @@ TYPE CONSTRUCTORS
associated type family F{2} :: forall a. Maybe a -> *
roles nominal nominal
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
=====================================
testsuite/tests/indexed-types/should_compile/T15852.stderr
=====================================
@@ -9,4 +9,4 @@ FAMILY INSTANCES
data instance forall {k1} {j :: k1} {k2} {c :: k2}.
DF (Proxy c) -- Defined at T15852.hs:10:15
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
=====================================
testsuite/tests/polykinds/T15592.stderr
=====================================
@@ -5,4 +5,4 @@ DATA CONSTRUCTORS
MkT :: forall {k} k1 (f :: k1 -> k -> *) (a :: k1) (b :: k).
f a b -> T f a b -> T f a b
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
=====================================
testsuite/tests/polykinds/T15592b.stderr
=====================================
@@ -4,4 +4,4 @@ TYPE CONSTRUCTORS
forall k (f :: k -> *) (a :: k). f a -> *
roles nominal nominal nominal nominal
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
=====================================
testsuite/tests/printer/T18052a.stderr
=====================================
@@ -6,7 +6,7 @@ TYPE CONSTRUCTORS
PATTERN SYNONYMS
(:||:) :: forall {a} {b}. a -> b -> (a, b)
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
==================== Tidy Core ====================
Result size of Tidy Core
=====================================
testsuite/tests/roles/should_compile/T8958.stderr
=====================================
@@ -16,7 +16,7 @@ CLASS INSTANCES
-- Defined at T8958.hs:11:10
instance [incoherent] Nominal a -- Defined at T8958.hs:8:10
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
==================== Typechecker ====================
T8958.$tcMap
=====================================
testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
=====================================
@@ -4,17 +4,17 @@ pdb.safePkg01/local.db
trusted: False
M_SafePkg
-package dependencies: base-4.16.3.0* ghc-bignum-1.2 ghc-prim-0.8.0
+package dependencies: base-4.16.4.0* ghc-bignum-1.2 ghc-prim-0.8.0
trusted: safe
require own pkg trusted: False
M_SafePkg2
-package dependencies: base-4.16.3.0 ghc-bignum-1.2 ghc-prim-0.8.0
+package dependencies: base-4.16.4.0 ghc-bignum-1.2 ghc-prim-0.8.0
trusted: trustworthy
require own pkg trusted: False
M_SafePkg3
-package dependencies: base-4.16.3.0* ghc-bignum-1.2 ghc-prim-0.8.0
+package dependencies: base-4.16.4.0* ghc-bignum-1.2 ghc-prim-0.8.0
trusted: safe
require own pkg trusted: True
@@ -24,7 +24,7 @@ trusted: safe
require own pkg trusted: True
M_SafePkg5
-package dependencies: base-4.16.3.0* ghc-bignum-1.2 ghc-prim-0.8.0
+package dependencies: base-4.16.4.0* ghc-bignum-1.2 ghc-prim-0.8.0
trusted: safe-inferred
require own pkg trusted: True
=====================================
testsuite/tests/typecheck/should_compile/T12763.stderr
=====================================
@@ -8,4 +8,4 @@ COERCION AXIOMS
CLASS INSTANCES
instance C Int -- Defined at T12763.hs:9:10
Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
=====================================
testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
=====================================
@@ -8,10 +8,10 @@ subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)]
Valid hole fits include
lines :: String -> [String]
(imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
- (and originally defined in ‘base-4.16.3.0:Data.OldList’))
+ (and originally defined in ‘base-4.16.4.0:Data.OldList’))
words :: String -> [String]
(imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
- (and originally defined in ‘base-4.16.3.0:Data.OldList’))
+ (and originally defined in ‘base-4.16.4.0:Data.OldList’))
read :: forall a. Read a => String -> a
with read @[String]
(imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c29100e6442b7ddd3275d7f0e806860472d24cca...040b80725bbc18db49023a53a73808c5c59cbbd4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c29100e6442b7ddd3275d7f0e806860472d24cca...040b80725bbc18db49023a53a73808c5c59cbbd4
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/20221102/23e8463b/attachment-0001.html>
More information about the ghc-commits
mailing list