[Git][ghc/ghc][master] 5 commits: Remove unnecessary irrefutable patterns from NonEmpty functions
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Dec 28 08:06:03 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
feb14af1 by Sergey Vinokurov at 2024-12-27T15:06:28+00:00
Remove unnecessary irrefutable patterns from NonEmpty functions
Implementation of https://github.com/haskell/core-libraries-committee/issues/107
- - - - -
6a0d91b4 by Sergey Vinokurov at 2024-12-27T15:06:28+00:00
Make cons, Semigroup, IsList, and Monad instances stricter
- - - - -
1249e597 by Sergey Vinokurov at 2024-12-27T15:06:28+00:00
Restore some laziness in <| and Semigroup instance, improve Monad instance
The Monad instance shouldn't produce the outer :| unless f a reduces
to WHNF. (Notice that the b :| bs match is implicitly lazy.)
- - - - -
8699d826 by Sergey Vinokurov at 2024-12-27T15:12:30+00:00
Add comment outlining Data.List.NonEmpty implementation guiding principles
- - - - -
7febe00e by Sergey Vinokurov at 2024-12-27T22:24:43+00:00
Fix tests since location of ‘>>=’ changed
- - - - -
12 changed files:
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/IsList.hs
- testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample
- testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample
- testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/profiling/should_run/ioprof.prof.sample
- testsuite/tests/profiling/should_run/toplevel_scc_1.prof.sample
Changes:
=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -20,6 +20,13 @@
-- @since 4.9.0.0
----------------------------------------------------------------------------
+-- Function implementations in this module adhere to the following principle:
+--
+-- For every NonEmpty function that is different from a corresponding
+-- List function only in the presence of NonEmpty in its type, both
+-- the List and NonEmpty functions should have the same strictness
+-- properties. Same applies to the class instances.
+
module Data.List.NonEmpty (
-- * The type of non-empty streams
NonEmpty(..)
@@ -185,7 +192,7 @@ nonEmpty (a:as) = Just (a :| as)
-- | 'uncons' produces the first element of the stream, and a stream of the
-- remaining elements, if any.
uncons :: NonEmpty a -> (a, Maybe (NonEmpty a))
-uncons ~(a :| as) = (a, nonEmpty as)
+uncons (a :| as) = (a, nonEmpty as)
-- | The 'unfoldr' function is analogous to "Data.List"'s
-- 'GHC.Internal.Data.List.unfoldr' operation.
@@ -222,7 +229,7 @@ singleton a = a :| []
-- | Prepend an element to the stream.
(<|) :: a -> NonEmpty a -> NonEmpty a
-a <| ~(b :| bs) = a :| b : bs
+a <| bs = a :| toList bs
-- | Synonym for '<|'.
cons :: a -> NonEmpty a -> NonEmpty a
@@ -274,7 +281,7 @@ fromList [] = error "NonEmpty.fromList: empty list"
-- | Convert a stream to a normal list efficiently.
toList :: NonEmpty a -> [a]
-toList ~(a :| as) = a : as
+toList (a :| as) = a : as
-- | Lift list operations to work on a 'NonEmpty' stream.
--
@@ -285,7 +292,7 @@ lift f = fromList . f . Foldable.toList
-- | Map a function over a 'NonEmpty' stream.
map :: (a -> b) -> NonEmpty a -> NonEmpty b
-map f ~(a :| as) = f a :| fmap f as
+map f (a :| as) = f a :| fmap f as
-- | The 'inits' function takes a stream @xs@ and returns all the
-- finite prefixes of @xs@, starting with the shortest. The result is
@@ -360,17 +367,17 @@ scanr f z = fromList . List.scanr f z . Foldable.toList
--
-- > scanl1 f [x1, x2, ...] == x1 :| [x1 `f` x2, x1 `f` (x2 `f` x3), ...]
scanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a
-scanl1 f ~(a :| as) = fromList (List.scanl f a as)
+scanl1 f (a :| as) = fromList (List.scanl f a as)
-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
scanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a
-scanr1 f ~(a :| as) = fromList (List.scanr1 f (a:as))
+scanr1 f (a :| as) = fromList (List.scanr1 f (a:as))
-- | 'intersperse x xs' alternates elements of the list with copies of @x at .
--
-- > intersperse 0 (1 :| [2,3]) == 1 :| [0,2,0,3]
intersperse :: a -> NonEmpty a -> NonEmpty a
-intersperse a ~(b :| bs) = b :| case bs of
+intersperse a (b :| bs) = b :| case bs of
[] -> []
_ -> a : List.intersperse a bs
@@ -533,7 +540,7 @@ isPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs
--
-- /Beware/: a negative or out-of-bounds index will cause an error.
(!!) :: HasCallStack => NonEmpty a -> Int -> a
-(!!) ~(x :| xs) n
+(!!) (x :| xs) n
| n == 0 = x
| n > 0 = xs List.!! (n - 1)
| otherwise = error "NonEmpty.!! negative index"
=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -755,7 +755,9 @@ efficient translations anyway.
-- | @since base-4.9.0.0
instance Semigroup (NonEmpty a) where
- (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)
+ (a :| as) <> bs = a :| (as ++ toList bs)
+ where
+ toList (c :| cs) = c : cs
-- | @since base-4.9.0.0
instance Semigroup b => Semigroup (a -> b) where
@@ -1709,8 +1711,8 @@ data NonEmpty a = a :| [a]
-- | @since base-4.9.0.0
instance Functor NonEmpty where
- fmap f ~(a :| as) = f a :| fmap f as
- b <$ ~(_ :| as) = b :| (b <$ as)
+ fmap f (a :| as) = f a :| fmap f as
+ b <$ (_ :| as) = b :| (b <$ as)
-- | @since base-4.9.0.0
instance Applicative NonEmpty where
@@ -1720,10 +1722,12 @@ instance Applicative NonEmpty where
-- | @since base-4.9.0.0
instance Monad NonEmpty where
- ~(a :| as) >>= f = b :| (bs ++ bs')
- where b :| bs = f a
- bs' = as >>= toList . f
- toList ~(c :| cs) = c : cs
+ (a :| as) >>= f =
+ case f a of
+ b :| bs -> b :| (bs ++ bs')
+ where
+ bs' = as >>= toList . f
+ toList (c :| cs) = c : cs
----------------------------------------------
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
=====================================
@@ -709,7 +709,7 @@ instance Foldable [] where
-- | @since base-4.9.0.0
instance Foldable NonEmpty where
- foldr f z ~(a :| as) = f a (List.foldr f z as)
+ foldr f z (a :| as) = f a (List.foldr f z as)
foldl f z (a :| as) = List.foldl f (f z a) as
foldl1 f (a :| as) = List.foldl f a as
@@ -729,9 +729,9 @@ instance Foldable NonEmpty where
-- The default definition also works great for null and foldl'.
-- As usual for cons lists, foldr' is basically hopeless.
- foldMap f ~(a :| as) = f a `mappend` foldMap f as
- fold ~(m :| ms) = m `mappend` fold ms
- toList ~(a :| as) = a : as
+ foldMap f (a :| as) = f a `mappend` foldMap f as
+ fold (m :| ms) = m `mappend` fold ms
+ toList (a :| as) = a : as
-- | @since base-4.7.0.0
instance Foldable (Either a) where
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs
=====================================
@@ -12,10 +12,10 @@ import qualified GHC.Internal.Data.List as List
-- | The 'zip' function takes two streams and returns a stream of
-- corresponding pairs.
zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)
-zip ~(x :| xs) ~(y :| ys) = (x, y) :| List.zip xs ys
+zip (x :| xs) (y :| ys) = (x, y) :| List.zip xs ys
-- | The 'zipWith' function generalizes 'zip'. Rather than tupling
-- the elements, the elements are combined using the function
-- passed as the first argument.
zipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
-zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys
+zipWith f (x :| xs) (y :| ys) = f x y :| List.zipWith f xs ys
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
=====================================
@@ -245,7 +245,7 @@ instance Traversable [] where
-- | @since base-4.9.0.0
instance Traversable NonEmpty where
- traverse f ~(a :| as) = liftA2 (:|) (f a) (traverse f as)
+ traverse f (a :| as) = liftA2 (:|) (f a) (traverse f as)
-- | @since base-4.7.0.0
instance Traversable (Either a) where
=====================================
libraries/ghc-internal/src/GHC/Internal/IsList.hs
=====================================
@@ -69,7 +69,7 @@ instance IsList (NonEmpty a) where
fromList (a:as) = a :| as
fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list"
- toList ~(a :| as) = a : as
+ toList (a :| as) = a : as
-- | @since base-4.8.0.0
instance IsList Version where
=====================================
testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample
=====================================
@@ -205,7 +205,7 @@ MAIN MAIN
repeat GHC.Internal.List libraries/ghc-internal/src/GHC/Internal/List.hs:941:1-6 431 1 0.0 0.0 0.0 0.0
take GHC.Internal.List libraries/ghc-internal/src/GHC/Internal/List.hs:1106:1-4 369 1 0.0 0.0 0.0 0.0
$wunsafeTake GHC.Internal.List libraries/ghc-internal/src/GHC/Internal/List.hs:1113:1-10 432 7 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 293 0 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 293 0 0.0 0.0 0.0 0.0
$fMonadIO1 GHC.Internal.Base <no location info> 294 1 0.0 0.0 0.0 0.0
getArgs GHC.Internal.System.Environment libraries/ghc-internal/src/GHC/Internal/System/Environment.hs:75:1-7 295 1 0.0 0.0 0.0 0.0
getArgs1 GHC.Internal.System.Environment <no location info> 296 1 0.0 0.0 0.0 0.0
@@ -295,7 +295,7 @@ MAIN MAIN
clauses Main Main.hs:68:1-74 434 1 0.0 0.0 0.0 0.0
Main.clauses(calling:GHC.Internal.Data.Foldable.concat) Main Main.hs:68:1-7 437 1 0.0 0.0 0.0 0.0
main Main Main.hs:(42,1)-(44,23) 290 1 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 291 1 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 291 1 0.0 0.0 0.0 0.0
redstar Main Main.hs:155:1-35 470 1 0.0 0.0 0.0 0.0
/= GHC.Classes libraries/ghc-prim/GHC/Classes.hs:218:5-42 473 1 0.0 0.0 0.0 0.0
spaces Main Main.hs:160:1-19 520 1 0.0 0.0 0.0 0.0
=====================================
testsuite/tests/profiling/should_run/caller-cc/CallerCc2.prof.sample
=====================================
@@ -204,7 +204,7 @@ MAIN MAIN
repeat GHC.Internal.List libraries/ghc-internal/src/GHC/Internal/List.hs:941:1-6 430 1 0.0 0.0 0.0 0.0
take GHC.Internal.List libraries/ghc-internal/src/GHC/Internal/List.hs:1106:1-4 368 1 0.0 0.0 0.0 0.0
$wunsafeTake GHC.Internal.List libraries/ghc-internal/src/GHC/Internal/List.hs:1113:1-10 431 7 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 293 0 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 293 0 0.0 0.0 0.0 0.0
$fMonadIO1 GHC.Internal.Base <no location info> 294 1 0.0 0.0 0.0 0.0
getArgs GHC.Internal.System.Environment libraries/ghc-internal/src/GHC/Internal/System/Environment.hs:75:1-7 295 1 0.0 0.0 0.0 0.0
getArgs1 GHC.Internal.System.Environment <no location info> 296 1 0.0 0.0 0.0 0.0
@@ -293,7 +293,7 @@ MAIN MAIN
CAF Main <entire-module> 150 0 0.0 0.0 0.0 0.0
clauses Main Main.hs:68:1-74 433 1 0.0 0.0 0.0 0.0
main Main Main.hs:(42,1)-(44,23) 290 1 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 291 1 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 291 1 0.0 0.0 0.0 0.0
redstar Main Main.hs:155:1-35 468 1 0.0 0.0 0.0 0.0
/= GHC.Classes libraries/ghc-prim/GHC/Classes.hs:218:5-42 471 1 0.0 0.0 0.0 0.0
spaces Main Main.hs:160:1-19 518 1 0.0 0.0 0.0 0.0
=====================================
testsuite/tests/profiling/should_run/caller-cc/CallerCc3.prof.sample
=====================================
@@ -204,7 +204,7 @@ MAIN MAIN
repeat GHC.Internal.List libraries/ghc-internal/src/GHC/Internal/List.hs:941:1-6 430 1 0.0 0.0 0.0 0.0
take GHC.Internal.List libraries/ghc-internal/src/GHC/Internal/List.hs:1106:1-4 368 1 0.0 0.0 0.0 0.0
$wunsafeTake GHC.Internal.List libraries/ghc-internal/src/GHC/Internal/List.hs:1113:1-10 431 7 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 293 0 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 293 0 0.0 0.0 0.0 0.0
$fMonadIO1 GHC.Internal.Base <no location info> 294 1 0.0 0.0 0.0 0.0
getArgs GHC.Internal.System.Environment libraries/ghc-internal/src/GHC/Internal/System/Environment.hs:75:1-7 295 1 0.0 0.0 0.0 0.0
getArgs1 GHC.Internal.System.Environment <no location info> 296 1 0.0 0.0 0.0 0.0
@@ -293,7 +293,7 @@ MAIN MAIN
CAF Main <entire-module> 150 0 0.0 0.0 0.0 0.0
clauses Main Main.hs:68:1-74 433 1 0.0 0.0 0.0 0.0
main Main Main.hs:(42,1)-(44,23) 290 1 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 291 1 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 291 1 0.0 0.0 0.0 0.0
redstar Main Main.hs:155:1-35 468 1 0.0 0.0 0.0 0.0
/= GHC.Classes libraries/ghc-prim/GHC/Classes.hs:218:5-42 471 1 0.0 0.0 0.0 0.0
spaces Main Main.hs:160:1-19 518 1 0.0 0.0 0.0 0.0
=====================================
testsuite/tests/profiling/should_run/callstack001.stdout
=====================================
@@ -1,2 +1,2 @@
-["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"]
-["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"]
+["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"]
+["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"]
=====================================
testsuite/tests/profiling/should_run/ioprof.prof.sample
=====================================
@@ -181,12 +181,12 @@ MAIN MAIN
liftA2 Main ioprof.hs:18:10-26 350 0 0.0 0.0 0.0 0.1
<*> Main ioprof.hs:20:5-14 352 0 0.0 0.0 0.0 0.0
ap GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1519:1-2 353 1 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 354 1 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 354 1 0.0 0.0 0.0 0.0
>>= Main ioprof.hs:(11,3)-(12,50) 355 1 0.0 0.0 0.0 0.0
$ GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:2266:1-3 356 1 0.0 0.0 0.0 0.0
fmap Main ioprof.hs:16:5-16 369 0 0.0 0.0 0.0 0.0
liftM GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1453:1-5 370 1 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 371 1 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 371 1 0.0 0.0 0.0 0.0
>>= Main ioprof.hs:(11,3)-(12,50) 372 1 0.0 0.0 0.0 0.0
$ GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:2266:1-3 373 1 0.0 0.0 0.0 0.0
runM Main ioprof.hs:26:1-37 343 1 0.0 0.0 0.0 85.4
@@ -332,13 +332,13 @@ MAIN MAIN
liftA2 Main ioprof.hs:18:10-26 361 0 0.0 0.0 0.0 0.0
<*> Main ioprof.hs:20:5-14 362 0 0.0 0.0 0.0 0.0
ap GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1519:1-2 363 0 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 364 0 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 364 0 0.0 0.0 0.0 0.0
>>= Main ioprof.hs:(11,3)-(12,50) 365 0 0.0 0.0 0.0 0.0
>>=.\ Main ioprof.hs:(11,27)-(12,50) 367 1 0.0 0.0 0.0 0.0
$ GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:2266:1-3 366 0 0.0 0.0 0.0 0.0
fmap Main ioprof.hs:16:5-16 374 0 0.0 0.0 0.0 0.0
liftM GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1453:1-5 375 0 0.0 0.0 0.0 0.0
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 376 0 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 376 0 0.0 0.0 0.0 0.0
>>= Main ioprof.hs:(11,3)-(12,50) 377 0 0.0 0.0 0.0 0.0
>>=.\ Main ioprof.hs:(11,27)-(12,50) 379 1 0.0 0.0 0.0 0.0
$ GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:2266:1-3 378 0 0.0 0.0 0.0 0.0
=====================================
testsuite/tests/profiling/should_run/toplevel_scc_1.prof.sample
=====================================
@@ -42,7 +42,7 @@ MAIN MAIN
runMainIO GHC.Internal.TopHandler libraries/ghc-internal/src/GHC/Internal/TopHandler.hs:90:1-9 276 1 0.0 0.0 0.0 0.0
runMainIO1 GHC.Internal.TopHandler <no location info> 277 1 0.0 0.3 0.0 22.4
setHandler1 GHC.Internal.Conc.Signal <no location info> 278 1 0.0 0.2 0.0 0.2
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 281 0 0.0 0.0 0.0 22.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 281 0 0.0 0.0 0.0 22.0
$fMonadIO1 GHC.Internal.Base <no location info> 282 1 0.0 0.0 0.0 22.0
. GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:2172:1-3 427 4 0.0 0.3 0.0 13.1
print GHC.Internal.System.IO libraries/ghc-internal/src/GHC/Internal/System/IO.hs:334:1-5 428 1 0.0 0.0 0.0 0.0
@@ -238,7 +238,7 @@ MAIN MAIN
lex_lvl125 GHC.Internal.Read <no location info> 400 1 0.0 0.0 0.0 0.1
gather_gath GHC.Internal.Text.ParserCombinators.ReadP libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadP.hs:253:3-6 401 1 0.0 0.1 0.0 0.1
CAF Main <entire-module> 145 0 0.0 0.3 0.0 0.6
- >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1346:5-55 280 1 0.0 0.0 0.0 0.0
+ >>= GHC.Internal.Base libraries/ghc-internal/src/GHC/Internal/Base.hs:1348:5-55 280 1 0.0 0.0 0.0 0.0
Main.f1 Main toplevel_scc_1.hs:4:1-2 455 1 0.0 0.1 0.0 0.1
+ GHC.Internal.Num libraries/ghc-internal/src/GHC/Internal/Num.hs:70:5-38 457 1 0.0 0.0 0.0 0.0
Main.foo Main toplevel_scc_1.hs:7:1-2 448 1 0.0 0.2 0.0 0.2
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bf0d58759ac6787000e101c05b7e73eaebfa5af...7febe00e66616d0fddc44c5a3998f1d6391b7ca3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bf0d58759ac6787000e101c05b7e73eaebfa5af...7febe00e66616d0fddc44c5a3998f1d6391b7ca3
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/20241228/885420da/attachment-0001.html>
More information about the ghc-commits
mailing list