[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Add Data.List.unsnoc
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu May 25 01:30:19 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00
Add Data.List.unsnoc
See https://github.com/haskell/core-libraries-committee/issues/165 for discussion
- - - - -
c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00
Fix crash in backpack signature merging with -ddump-rn-trace
In some cases, backpack signature merging could crash in addUsedGRE
when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause
unavailable interfaces to be loaded.
This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE
when -ddump-rn-trace is enabled.
Fixes #23424
Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com>
- - - - -
1b31742d by Krzysztof Gogolewski at 2023-05-24T21:30:11-04:00
Add a regression test for #13981
The panic was fixed by 6998772043a7f0b. Fixes #13981.
- - - - -
77ce80f9 by Krzysztof Gogolewski at 2023-05-24T21:30:11-04:00
Add a test for #23355
It was fixed by !10061, so I'm adding it in the same group.
- - - - -
21 changed files:
- compiler/GHC/Rename/Env.hs
- libraries/base/Data/List.hs
- libraries/base/Data/OldList.hs
- libraries/base/GHC/List.hs
- libraries/base/changelog.md
- testsuite/driver/testlib.py
- + testsuite/tests/backpack/should_compile/T23424.bkp
- testsuite/tests/backpack/should_compile/all.T
- + testsuite/tests/ghci/should_run/T22958c.hs
- + testsuite/tests/ghci/should_run/T22958c.stdout
- testsuite/tests/ghci/should_run/all.T
- + testsuite/tests/lib/base/Unsnoc.hs
- + testsuite/tests/lib/base/Unsnoc.stdout
- testsuite/tests/lib/base/all.T
- + testsuite/tests/typecheck/should_fail/T13981A.hs
- + testsuite/tests/typecheck/should_fail/T13981A.hs-boot
- + testsuite/tests/typecheck/should_fail/T13981A.stderr
- + testsuite/tests/typecheck/should_fail/T13981B.hs
- + testsuite/tests/typecheck/should_fail/T13981C.hs
- + testsuite/tests/typecheck/should_fail/T13981F.hs
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -1742,7 +1742,8 @@ addUsedGRE warn_if_deprec gre
DisableDeprecationWarnings -> return ()
; unless (isLocalGRE gre) $
do { env <- getGblEnv
- ; traceRn "addUsedGRE" (ppr gre)
+ -- Do not report the GREInfo (#23424)
+ ; traceRn "addUsedGRE" (ppr $ greName gre)
; updMutVar (tcg_used_gres env) (gre :) } }
addUsedGREs :: [GlobalRdrElt] -> RnM ()
@@ -1752,7 +1753,9 @@ addUsedGREs :: [GlobalRdrElt] -> RnM ()
addUsedGREs gres
| null imp_gres = return ()
| otherwise = do { env <- getGblEnv
- ; traceRn "addUsedGREs" (ppr imp_gres)
+ -- Do not report the GREInfo (#23424)
+ ; traceRn "addUsedGREs"
+ (ppr $ map greName imp_gres)
; updMutVar (tcg_used_gres env) (imp_gres ++) }
where
imp_gres = filterOut isLocalGRE gres
=====================================
libraries/base/Data/List.hs
=====================================
@@ -25,6 +25,7 @@ module Data.List
, tail
, init
, uncons
+ , unsnoc
, singleton
, null
, length
=====================================
libraries/base/Data/OldList.hs
=====================================
@@ -26,6 +26,7 @@ module Data.OldList
, tail
, init
, uncons
+ , unsnoc
, singleton
, null
, length
=====================================
libraries/base/GHC/List.hs
=====================================
@@ -31,7 +31,7 @@ module GHC.List (
-- Other functions
foldl1', concat, concatMap,
map, (++), filter, lookup,
- head, last, tail, init, uncons, (!?), (!!),
+ head, last, tail, init, uncons, unsnoc, (!?), (!!),
scanl, scanl1, scanl', scanr, scanr1,
iterate, iterate', repeat, replicate, cycle,
take, drop, splitAt, takeWhile, dropWhile, span, break, reverse,
@@ -97,11 +97,11 @@ badHead = errorEmptyList "head"
head (augment g xs) = g (\x _ -> x) (head xs)
#-}
--- | \(\mathcal{O}(1)\). Decompose a list into its head and tail.
+-- | \(\mathcal{O}(1)\). Decompose a list into its 'head' and 'tail'.
--
-- * If the list is empty, returns 'Nothing'.
-- * If the list is non-empty, returns @'Just' (x, xs)@,
--- where @x@ is the head of the list and @xs@ its tail.
+-- where @x@ is the 'head' of the list and @xs@ its 'tail'.
--
-- @since 4.8.0.0
--
@@ -115,6 +115,41 @@ uncons :: [a] -> Maybe (a, [a])
uncons [] = Nothing
uncons (x:xs) = Just (x, xs)
+-- | \(\mathcal{O}(n)\). Decompose a list into 'init' and 'last'.
+--
+-- * If the list is empty, returns 'Nothing'.
+-- * If the list is non-empty, returns @'Just' (xs, x)@,
+-- where @xs@ is the 'init'ial part of the list and @x@ is its 'last' element.
+--
+-- @since 4.19.0.0
+--
+-- >>> unsnoc []
+-- Nothing
+-- >>> unsnoc [1]
+-- Just ([],1)
+-- >>> unsnoc [1, 2, 3]
+-- Just ([1,2],3)
+--
+-- Laziness:
+--
+-- >>> fst <$> unsnoc [undefined]
+-- Just []
+-- >>> head . fst <$> unsnoc (1 : undefined)
+-- Just *** Exception: Prelude.undefined
+-- >>> head . fst <$> unsnoc (1 : 2 : undefined)
+-- Just 1
+--
+-- 'unsnoc' is dual to 'uncons': for a finite list @xs@
+--
+-- > unsnoc xs = (\(hd, tl) -> (reverse tl, hd)) <$> uncons (reverse xs)
+--
+unsnoc :: [a] -> Maybe ([a], a)
+-- The lazy pattern ~(a, b) is important to be productive on infinite lists
+-- and not to be prone to stack overflows.
+-- Expressing the recursion via 'foldr' provides for list fusion.
+unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing
+{-# INLINABLE unsnoc #-}
+
-- | \(\mathcal{O}(1)\). Extract the elements after the head of a list, which
-- must be non-empty.
--
@@ -143,8 +178,7 @@ tail [] = errorEmptyList "tail"
-- >>> last []
-- *** Exception: Prelude.last: empty list
--
--- WARNING: This function is partial. You can use 'reverse' with case-matching,
--- 'uncons' or 'listToMaybe' instead.
+-- WARNING: This function is partial. Consider using 'unsnoc' instead.
last :: HasCallStack => [a] -> a
#if defined(USE_REPORT_PRELUDE)
last [x] = x
@@ -172,8 +206,7 @@ lastError = errorEmptyList "last"
-- >>> init []
-- *** Exception: Prelude.init: empty list
--
--- WARNING: This function is partial. You can use 'reverse' with case-matching
--- or 'uncons' instead.
+-- WARNING: This function is partial. Consider using 'unsnoc' instead.
init :: HasCallStack => [a] -> [a]
#if defined(USE_REPORT_PRELUDE)
init [x] = []
=====================================
libraries/base/changelog.md
=====================================
@@ -16,6 +16,7 @@
* Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88))
* Add `System.Mem.Weak.{get,set}FinalizerExceptionHandler`, which allows the user to set the global handler invoked by when a `Weak` pointer finalizer throws an exception. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126))
* Add `System.Mem.Weak.printToHandleFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to the given `Handle`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126))
+ * Add `Data.List.unsnoc` ([CLC proposal #165](https://github.com/haskell/core-libraries-committee/issues/165))
* Implement more members of `instance Foldable (Compose f g)` explicitly.
([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57))
* Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`.
=====================================
testsuite/driver/testlib.py
=====================================
@@ -2201,6 +2201,11 @@ async def compare_outputs(way: WayName,
normaliser: OutputNormalizer,
expected_file, actual_file, diff_file=None,
whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool:
+ # Respect ignore_stdout and ignore_stderr options
+ if kind == 'stderr' and getTestOpts().ignore_stderr:
+ return True
+ if kind == 'stdout' and getTestOpts().ignore_stdout:
+ return True
expected_path = in_srcdir(expected_file)
actual_path = in_testdir(actual_file)
=====================================
testsuite/tests/backpack/should_compile/T23424.bkp
=====================================
@@ -0,0 +1,23 @@
+unit p where
+ signature A where
+ data T
+ x :: Bool
+ signature B where
+ import A
+ y :: T
+ z :: Bool
+unit q where
+ dependency signature p[A=<A>,B=<B>]
+ signature A (x) where
+ signature B (z) where
+ module M(y) where
+ import A
+ import B
+ y = x && z
+unit pimpl where
+ module A where
+ x = True
+ module B where
+ z = False
+unit r where
+ dependency q[A=pimpl:A,B=pimpl:B]
=====================================
testsuite/tests/backpack/should_compile/all.T
=====================================
@@ -60,3 +60,4 @@ test('T13214', normal, backpack_compile, [''])
test('T13250', normal, backpack_compile, [''])
test('T13323', normal, backpack_compile, [''])
test('T20396', normal, backpack_compile, [''])
+test('T23424', [ignore_stdout, ignore_stderr], backpack_compile, ['-ddump-rn-trace -ddump-if-trace -ddump-tc-trace'])
\ No newline at end of file
=====================================
testsuite/tests/ghci/should_run/T22958c.hs
=====================================
@@ -0,0 +1,15 @@
+-- Test extracted from text-builder-linear, ticket #23355
+{-# LANGUAGE UnliftedDatatypes #-}
+module Main (main) where
+
+import GHC.Exts (UnliftedType)
+
+type Buffer :: UnliftedType
+data Buffer = Buffer
+
+main :: IO ()
+main = case i Buffer of Buffer -> putStrLn "good"
+
+{-# NOINLINE i #-}
+i :: forall (a :: UnliftedType). a -> a
+i x = x
=====================================
testsuite/tests/ghci/should_run/T22958c.stdout
=====================================
@@ -0,0 +1 @@
+good
=====================================
testsuite/tests/ghci/should_run/all.T
=====================================
@@ -90,3 +90,4 @@ test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], co
test('T23229', just_ghci + [extra_hc_opts("-this-unit-id my-package -Wno-missing-methods T23229")], ghci_script, ['T23229.script'])
test('T22958a', just_ghci, compile_and_run, [''])
test('T22958b', just_ghci, compile_and_run, [''])
+test('T22958c', just_ghci, compile_and_run, [''])
=====================================
testsuite/tests/lib/base/Unsnoc.hs
=====================================
@@ -0,0 +1,14 @@
+{-# OPTIONS_GHC -Wno-x-partial #-}
+
+module Main (main) where
+
+import Data.List (unsnoc)
+
+main :: IO ()
+main = do
+ print $ unsnoc ([] :: [Int])
+ print $ unsnoc [1]
+ print $ unsnoc [1, 2, 3]
+ print $ fst <$> unsnoc [undefined :: Int]
+ print $ head . fst <$> unsnoc (1 : 2 : undefined)
+ print $ head . fst <$> unsnoc [1..]
=====================================
testsuite/tests/lib/base/Unsnoc.stdout
=====================================
@@ -0,0 +1,6 @@
+Nothing
+Just ([],1)
+Just ([1,2],3)
+Just []
+Just 1
+Just 1
=====================================
testsuite/tests/lib/base/all.T
=====================================
@@ -8,3 +8,4 @@ test('executablePath', [extra_run_opts(config.os), js_broken(22261), when(arch('
test('T17472', normal, compile_and_run, [''])
test('T19569b', normal, compile_and_run, [''])
test('Monoid_ByteArray', normal, compile_and_run, [''])
+test('Unsnoc', normal, compile_and_run, [''])
=====================================
testsuite/tests/typecheck/should_fail/T13981A.hs
=====================================
@@ -0,0 +1,5 @@
+module T13981A where
+import T13981B
+import T13981C
+
+data T = T
=====================================
testsuite/tests/typecheck/should_fail/T13981A.hs-boot
=====================================
@@ -0,0 +1,2 @@
+module T13981A where
+data T
=====================================
testsuite/tests/typecheck/should_fail/T13981A.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T13981A.hs:1:1: error: [GHC-34447]
+ Conflicting family instance declarations:
+ T13981F.F T13981A.T = Int -- Defined in module T13981B
+ T13981F.F T13981A.T = Bool -- Defined in module T13981C
=====================================
testsuite/tests/typecheck/should_fail/T13981B.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+module T13981B where
+import {-# SOURCE #-} T13981A
+import T13981F
+type instance F T = Int
=====================================
testsuite/tests/typecheck/should_fail/T13981C.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+module T13981C where
+import {-# SOURCE #-} T13981A
+import T13981F
+type instance F T = Bool
=====================================
testsuite/tests/typecheck/should_fail/T13981F.hs
=====================================
@@ -0,0 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
+module T13981F where
+import Data.Kind
+type family F a :: Type
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -684,3 +684,4 @@ test('CommonFieldResultTypeMismatch', normal, compile_fail, [''])
test('CommonFieldTypeMismatch', normal, compile_fail, [''])
test('T17284', normal, compile_fail, [''])
test('T23427', normal, compile_fail, [''])
+test('T13981A', [extra_files(['T13981A.hs-boot', 'T13981B.hs', 'T13981C.hs', 'T13981F.hs'])], multimod_compile_fail, ['T13981A', '-v0'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a588b8013f733fe91e1285f63cdb36e56284084e...77ce80f9a376ba8be779a2711151f5bfd2d6f9bb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a588b8013f733fe91e1285f63cdb36e56284084e...77ce80f9a376ba8be779a2711151f5bfd2d6f9bb
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/20230524/0e33322c/attachment-0001.html>
More information about the ghc-commits
mailing list