[Git][ghc/ghc][wip/filepath-1.5] 4 commits: Make decomposeRuleLhs a bit more clever
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Thu Feb 1 13:39:37 UTC 2024
Zubin pushed to branch wip/filepath-1.5 at Glasgow Haskell Compiler / GHC
Commits:
ca2e919e by Simon Peyton Jones at 2024-01-31T09:29:45+00:00
Make decomposeRuleLhs a bit more clever
This fixes #24370 by making decomposeRuleLhs undertand
dictionary /functions/ as well as plain /dictionaries/
- - - - -
94ce031d by Teo Camarasu at 2024-02-01T05:49:49-05:00
doc: Add -Dn flag to user guide
Resolves #24394
- - - - -
8a47c243 by Ben Gamari at 2024-02-01T13:39:33+00:00
Add os-string as a boot package
Introduces `os-string` submodule. This will be necessary for
`filepath-1.5`.
- - - - -
d1139dff by Ben Gamari at 2024-02-01T13:39:33+00:00
Bump filepath to 1.5.0.0
Required bumps of the following submodules:
* `directory`
* `filepath`
* `haskeline`
* `process`
* `unix`
* `hsc2hs`
* `Win32`
* `semaphore-compat`
and the addition of `os-string` as a boot package.
- - - - -
22 changed files:
- .gitmodules
- compiler/GHC.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/ghc.cabal.in
- docs/users_guide/runtime_control.rst
- ghc/ghc-bin.cabal.in
- hadrian/src/Packages.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Packages.hs
- libraries/Cabal
- libraries/Win32
- libraries/directory
- libraries/filepath
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghci/ghci.cabal.in
- + libraries/os-string
- libraries/process
- libraries/semaphore-compat
- libraries/unix
- + testsuite/tests/simplCore/should_compile/T24370.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
.gitmodules
=====================================
@@ -117,3 +117,6 @@
[submodule "utils/hpc"]
path = utils/hpc
url = https://gitlab.haskell.org/hpc/hpc-bin.git
+[submodule "libraries/os-string"]
+ path = libraries/os-string
+ url = https://gitlab.haskell.org/ghc/packages/os-string
=====================================
compiler/GHC.hs
=====================================
@@ -1515,9 +1515,7 @@ modInfoModBreaks :: ModuleInfo -> ModBreaks
modInfoModBreaks = minf_modBreaks
isDictonaryId :: Id -> Bool
-isDictonaryId id
- = case tcSplitSigmaTy (idType id) of {
- (_tvs, _theta, tau) -> isDictTy tau }
+isDictonaryId id = isDictTy (idType id)
-- | Looks up a global name: that is, any top-level name in any
-- visible module. Unlike 'lookupName', lookupGlobalName does not use
=====================================
compiler/GHC/Core/Predicate.hs
=====================================
@@ -99,7 +99,14 @@ mkClassPred :: Class -> [Type] -> PredType
mkClassPred clas tys = mkTyConApp (classTyCon clas) tys
isDictTy :: Type -> Bool
-isDictTy = isClassPred
+-- True of dictionaries (Eq a) and
+-- dictionary functions (forall a. Eq a => Eq [a])
+-- See Note [Type determines value]
+-- See #24370 (and the isDictId call in GHC.HsToCore.Binds.decomposeRuleLhs)
+-- for why it's important to catch dictionary bindings
+isDictTy ty = isClassPred pred
+ where
+ (_, pred) = splitInvisPiTys ty
typeDeterminesValue :: Type -> Bool
-- See Note [Type determines value]
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -987,7 +987,16 @@ decomposeRuleLhs dflags orig_bndrs orig_lhs rhs_fvs
= Left (DsRuleIgnoredDueToConstructor con) -- See Note [No RULES on datacons]
| otherwise = case decompose fun2 args2 of
- Nothing -> Left (DsRuleLhsTooComplicated orig_lhs lhs2)
+ Nothing -> -- pprTrace "decomposeRuleLhs 3" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
+ -- , text "orig_lhs:" <+> ppr orig_lhs
+ -- , text "rhs_fvs:" <+> ppr rhs_fvs
+ -- , text "orig_lhs:" <+> ppr orig_lhs
+ -- , text "lhs1:" <+> ppr lhs1
+ -- , text "lhs2:" <+> ppr lhs2
+ -- , text "fun2:" <+> ppr fun2
+ -- , text "args2:" <+> ppr args2
+ -- ]) $
+ Left (DsRuleLhsTooComplicated orig_lhs lhs2)
Just (fn_id, args)
| not (null unbound) ->
-- Check for things unbound on LHS
@@ -1059,7 +1068,9 @@ decomposeRuleLhs dflags orig_bndrs orig_lhs rhs_fvs
split_lets :: CoreExpr -> ([(DictId,CoreExpr)], CoreExpr)
split_lets (Let (NonRec d r) body)
- | isDictId d
+ | isDictId d -- Catches dictionaries, yes, but also catches dictionary
+ -- /functions/ arising from solving a
+ -- quantified contraint (#24370)
= ((d,r):bs, body')
where (bs, body') = split_lets body
=====================================
compiler/ghc.cabal.in
=====================================
@@ -116,7 +116,7 @@ Library
time >= 1.4 && < 1.13,
containers >= 0.6.2.1 && < 0.8,
array >= 0.1 && < 0.6,
- filepath >= 1 && < 1.5,
+ filepath >= 1 && < 1.6,
template-haskell == 2.21.*,
hpc >= 0.6 && < 0.8,
transformers >= 0.5 && < 0.7,
@@ -128,7 +128,7 @@ Library
ghci == @ProjectVersionMunged@
if os(windows)
- Build-Depends: Win32 >= 2.3 && < 2.14
+ Build-Depends: Win32 >= 2.3 && < 2.15
else
Build-Depends: unix >= 2.7 && < 2.9
=====================================
docs/users_guide/runtime_control.rst
=====================================
@@ -1408,6 +1408,7 @@ recommended for everyday use!
.. rts-flag:: -Dl DEBUG: linker
.. rts-flag:: -DL DEBUG: linker (verbose); implies :rts-flag:`-Dl`
.. rts-flag:: -Dm DEBUG: stm
+.. rts-flag:: -Dn DEBUG: non-moving garbage collector
.. rts-flag:: -Dz DEBUG: stack squeezing
.. rts-flag:: -Dc DEBUG: program coverage
.. rts-flag:: -Dr DEBUG: sparks
=====================================
ghc/ghc-bin.cabal.in
=====================================
@@ -36,14 +36,14 @@ Executable ghc
bytestring >= 0.9 && < 0.13,
directory >= 1 && < 1.4,
process >= 1 && < 1.7,
- filepath >= 1 && < 1.5,
+ filepath >= 1 && < 1.6,
containers >= 0.5 && < 0.8,
transformers >= 0.5 && < 0.7,
ghc-boot == @ProjectVersionMunged@,
ghc == @ProjectVersionMunged@
if os(windows)
- Build-Depends: Win32 >= 2.3 && < 2.14
+ Build-Depends: Win32 >= 2.3 && < 2.15
else
Build-Depends: unix >= 2.7 && < 2.9
=====================================
hadrian/src/Packages.hs
=====================================
@@ -8,7 +8,7 @@ module Packages (
ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim,
ghcToolchain, ghcToolchainBin, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
- libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts,
+ libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts,
runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy,
transformers, unlit, unix, win32, xhtml,
lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace,
@@ -40,7 +40,7 @@ ghcPackages =
, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform
, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim
, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs
- , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl
+ , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl, osString
, parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell
, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml
, timeout
@@ -58,7 +58,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count
ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim,
ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs,
hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl,
- parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell,
+ osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell,
terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml,
timeout,
lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace
@@ -112,6 +112,7 @@ iserv = util "iserv"
iservProxy = util "iserv-proxy"
libffi = top "libffi"
mtl = lib "mtl"
+osString = lib "os-string"
parsec = lib "parsec"
pretty = lib "pretty"
primitive = lib "primitive"
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -104,6 +104,7 @@ stage0Packages = do
, hpc
, hpcBin
, mtl
+ , osString
, parsec
, semaphoreCompat
, time
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -157,6 +157,10 @@ packageArgs = do
]
+ , package unix ? builder (Cabal Flags) ? arg "+os-string"
+ , package directory ? builder (Cabal Flags) ? arg "+os-string"
+ , package win32 ? builder (Cabal Flags) ? arg "+os-string"
+
--------------------------------- iserv --------------------------------
-- Add -Wl,--export-dynamic enables GHCi to load dynamic objects that
-- refer to the RTS. This is harmless if you don't use it (adds a bit
=====================================
libraries/Cabal
=====================================
@@ -1 +1 @@
-Subproject commit ae3c40a20bf98870488e3b40fc4495009b026e33
+Subproject commit ec71ed5b44d7a35e3b421c0d3f1f9f52cc434992
=====================================
libraries/Win32
=====================================
@@ -1 +1 @@
-Subproject commit efab7f1146da9741dc54fb35476d4aaabeff8d6d
+Subproject commit 350ebd43f9a8d9e1ca767b0000f95bdfb42a5471
=====================================
libraries/directory
=====================================
@@ -1 +1 @@
-Subproject commit a0c9361817db13917df7777f669a97c4d787f44e
+Subproject commit fc38cbfc5c7c4b631ed89d6b41bbe00ee96c8b21
=====================================
libraries/filepath
=====================================
@@ -1 +1 @@
-Subproject commit cdb5171f7774569b1a8028a78392cfa79f732b5c
+Subproject commit b55465e3d174ccd63914e7146079435503204187
=====================================
libraries/ghc-boot/ghc-boot.cabal.in
=====================================
@@ -78,7 +78,7 @@ Library
bytestring >= 0.10 && < 0.13,
containers >= 0.5 && < 0.8,
directory >= 1.2 && < 1.4,
- filepath >= 1.3 && < 1.5,
+ filepath >= 1.3 && < 1.6,
deepseq >= 1.4 && < 1.6,
ghc-platform >= 0.1,
ghc-boot-th == @ProjectVersionMunged@
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -81,7 +81,7 @@ library
bytestring >= 0.10 && < 0.13,
containers >= 0.5 && < 0.8,
deepseq >= 1.4 && < 1.6,
- filepath == 1.4.*,
+ filepath >= 1.4 && < 1.6,
ghc-boot == @ProjectVersionMunged@,
ghc-heap == @ProjectVersionMunged@,
template-haskell == 2.21.*,
=====================================
libraries/os-string
=====================================
@@ -0,0 +1 @@
+Subproject commit fb2711ba1f43fd609de0e231e161025ee8ed3216
=====================================
libraries/process
=====================================
@@ -1 +1 @@
-Subproject commit 5ba847afd894b560b7a7c2569c99bb9f4c8cb282
+Subproject commit dfdae0a7036b42d352a515214e6116424dd08ec9
=====================================
libraries/semaphore-compat
=====================================
@@ -1 +1 @@
-Subproject commit c8fc7b1757b4eecbd10239038fbc6602340105b1
+Subproject commit 8cd32a85388c7b51786a7aedd15404e2e4896f1b
=====================================
libraries/unix
=====================================
@@ -1 +1 @@
-Subproject commit 0b3dbc9901fdf2d752c4ee7a7cee7b1ed20e76bd
+Subproject commit 7db23ecad7593210ce38c48a462be6c50d080e00
=====================================
testsuite/tests/simplCore/should_compile/T24370.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE QuantifiedConstraints, UndecidableInstances #-}
+
+-- This gave "RULE left-hand side too complicated to desugar"
+-- in GHC 9.8
+
+module T24370 where
+
+f :: (Eq a, Eq a) => a -> b -> Int
+f = error "urk"
+
+{-# SPECIALISE f :: T Maybe -> b -> Int #-}
+
+instance (forall a. Eq a => Eq (f a)) => Eq (T f) where
+ a == b = False
+
+data T f = MkT (f Int)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -511,3 +511,4 @@ test('T21917', normal, compile, ['-O -fkeep-auto-rules -ddump-rules'])
test('T23209', [extra_files(['T23209_Aux.hs'])], multimod_compile, ['T23209', '-v0 -O'])
test('T24229a', [ grep_errmsg(r'wfoo') ], compile, ['-O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques -dppr-cols=99999'])
test('T24229b', [ grep_errmsg(r'wfoo') ], compile, ['-O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques -dppr-cols=99999'])
+test('T24370', normal, compile, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbb52840545ef4f9066a1c8db247f866f4f5b132...d1139dff003adcdbfbc9137c1816022f1ecd59ea
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbb52840545ef4f9066a1c8db247f866f4f5b132...d1139dff003adcdbfbc9137c1816022f1ecd59ea
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/20240201/3d44ef2c/attachment-0001.html>
More information about the ghc-commits
mailing list