Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
1aac7095
by sheaf at 2026-08-16T04:37:16-04:00
3 changed files:
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Data/Unboxed.hs
- testsuite/tests/count-deps/CountDepsParser.stdout
Changes:
| ... | ... | @@ -147,6 +147,7 @@ import GHC.Types.Basic |
| 147 | 147 | import GHC.Types.Unique
|
| 148 | 148 | import GHC.Data.FastString
|
| 149 | 149 | import GHC.Data.Pair
|
| 150 | +import GHC.Data.Unboxed (traverseMaybeUB)
|
|
| 150 | 151 | import GHC.Types.SrcLoc
|
| 151 | 152 | import GHC.Builtin.KnownKeys
|
| 152 | 153 | import GHC.Builtin.WiredIn.Prim
|
| ... | ... | @@ -166,6 +167,7 @@ import Data.Char( isDigit ) |
| 166 | 167 | import qualified Data.Monoid as Monoid
|
| 167 | 168 | import Data.List.NonEmpty ( NonEmpty (..) )
|
| 168 | 169 | import Control.DeepSeq
|
| 170 | +import GHC.Exts (inline)
|
|
| 169 | 171 | |
| 170 | 172 | {-
|
| 171 | 173 | %************************************************************************
|
| ... | ... | @@ -722,6 +724,19 @@ isReflexiveCo_maybe co |
| 722 | 724 | = Nothing
|
| 723 | 725 | where (Pair ty1 ty2, r) = coercionKindRole co
|
| 724 | 726 | |
| 727 | +-- | Like @\\ cos -> map fst <$> traverse isReflCo_maybe cos@,
|
|
| 728 | +-- but avoiding wasteful allocations (see #27648).
|
|
| 729 | +reflCos_maybe :: [Coercion] -> Maybe [Type]
|
|
| 730 | +reflCos_maybe =
|
|
| 731 | + traverseMaybeUB
|
|
| 732 | + ( fmap fst
|
|
| 733 | + . inline isReflCo_maybe
|
|
| 734 | + -- isReflCo_maybe must inline so that 'fmap fst' fuses and the whole
|
|
| 735 | + -- function inlines into 'traverseMaybeUB'
|
|
| 736 | + )
|
|
| 737 | +{-# INLINE reflCos_maybe #-}
|
|
| 738 | + -- to avoid allocating the result's 'Just' constructor application
|
|
| 739 | + |
|
| 725 | 740 | forAllCoKindCo :: TyCoVar -> KindMCoercion -> KindCoercion
|
| 726 | 741 | -- Get the kind coercion from a ForAllCo
|
| 727 | 742 | forAllCoKindCo _ (MCo co) = co
|
| ... | ... | @@ -811,8 +826,8 @@ mkTyConAppCo r tc cos |
| 811 | 826 | | ExpandsSyn tv_co_prs rhs_ty leftover_cos <- expandSynTyCon_maybe tc cos
|
| 812 | 827 | = mkAppCos (liftCoSubst r (mkLiftingContext tv_co_prs) rhs_ty) leftover_cos
|
| 813 | 828 | |
| 814 | - | Just tys_roles <- traverse isReflCo_maybe cos
|
|
| 815 | - = mkReflCo r (mkTyConApp tc (map fst tys_roles))
|
|
| 829 | + | Just tys <- reflCos_maybe cos
|
|
| 830 | + = mkReflCo r $! mkTyConApp tc tys
|
|
| 816 | 831 | -- See Note [Refl invariant]
|
| 817 | 832 | |
| 818 | 833 | | otherwise = TyConAppCo r tc cos
|
| ... | ... | @@ -13,10 +13,11 @@ |
| 13 | 13 | |
| 14 | 14 | module GHC.Data.Unboxed (
|
| 15 | 15 | MaybeUB(JustUB, NothingUB),
|
| 16 | - fmapMaybeUB, fromMaybeUB, apMaybeUB, maybeUB
|
|
| 16 | + fmapMaybeUB, fromMaybeUB, apMaybeUB, maybeUB,
|
|
| 17 | + traverseMaybeUB
|
|
| 17 | 18 | ) where
|
| 18 | 19 | |
| 19 | -import GHC.Prelude hiding (Maybe(..), Either(..))
|
|
| 20 | +import GHC.Prelude
|
|
| 20 | 21 | |
| 21 | 22 | -- | Like Maybe, but using unboxed sums.
|
| 22 | 23 | --
|
| ... | ... | @@ -54,3 +55,28 @@ fmapMaybeUB f (JustUB x) = JustUB $ f x |
| 54 | 55 | maybeUB :: b -> (a -> b) -> MaybeUB a -> b
|
| 55 | 56 | maybeUB _def f (JustUB x) = f x
|
| 56 | 57 | maybeUB def _f NothingUB = def
|
| 58 | + |
|
| 59 | +toMaybe :: MaybeUB a -> Maybe a
|
|
| 60 | +toMaybe NothingUB = Nothing
|
|
| 61 | +toMaybe (JustUB a) = Just a
|
|
| 62 | + |
|
| 63 | +-- | Like 'traverse' for the 'Maybe' applicative, but avoiding intermediate
|
|
| 64 | +-- allocations.
|
|
| 65 | +--
|
|
| 66 | +-- The passed-in function must inline for this to help at all.
|
|
| 67 | +traverseMaybeUB
|
|
| 68 | + :: forall a b
|
|
| 69 | + . (a -> Maybe b) -- ^ @INLINE@ function to map over the list
|
|
| 70 | + -> [a] -> Maybe [b]
|
|
| 71 | +{-# INLINE traverseMaybeUB #-}
|
|
| 72 | + -- 'traverseMaybeUB' must inline so that the function it is passed can inline
|
|
| 73 | +traverseMaybeUB f = \ xs -> toMaybe $ go xs
|
|
| 74 | + where
|
|
| 75 | + go :: [a] -> MaybeUB [b]
|
|
| 76 | + go [] = JustUB []
|
|
| 77 | + go (a:as)
|
|
| 78 | + | Just b <- f a -- f is assumed to inline
|
|
| 79 | + , JustUB bs <- go as
|
|
| 80 | + = JustUB (b:bs)
|
|
| 81 | + | otherwise
|
|
| 82 | + = NothingUB |
| ... | ... | @@ -86,6 +86,7 @@ GHC.Data.Pair |
| 86 | 86 | GHC.Data.Strict
|
| 87 | 87 | GHC.Data.StringBuffer
|
| 88 | 88 | GHC.Data.TrieMap
|
| 89 | +GHC.Data.Unboxed
|
|
| 89 | 90 | GHC.Data.Word64Map
|
| 90 | 91 | GHC.Data.Word64Map.Internal
|
| 91 | 92 | GHC.Data.Word64Map.Lazy
|