Simon Peyton Jones pushed to branch wip/T23109a at Glasgow Haskell Compiler / GHC Commits: 2bb593cc by Simon Peyton Jones at 2025-04-21T18:14:38+01:00 Specialise the (higher order) showSignedFloat - - - - - 61760473 by Simon Peyton Jones at 2025-04-21T18:15:16+01:00 Eta reduce augment and its rules ... to match foldr. I found this reduced some simplifer iterations - - - - - af0ef54b by Simon Peyton Jones at 2025-04-21T18:16:14+01:00 Try getting rid of this early-phase business - - - - - cba0eb2f by Simon Peyton Jones at 2025-04-21T18:16:45+01:00 Don't float PAPs to top level ...and treat case alternatives as strict contexts - - - - - 4 changed files: - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - libraries/ghc-internal/src/GHC/Internal/Base.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs Changes: ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -406,7 +406,7 @@ lvlApp env orig_expr ((_,AnnVar fn), args) , arity < n_val_args , Nothing <- isClassOpId_maybe fn = do { rargs' <- mapM (lvlNonTailMFE env False) rargs - ; lapp' <- lvlNonTailMFE env False lapp + ; lapp' <- lvlNonTailMFE env True lapp ; return (foldl' App lapp' rargs') } | otherwise @@ -707,16 +707,20 @@ lvlMFE env strict_ctxt ann_expr escapes_value_lam = dest_lvl `ltMajLvl` (le_ctxt_lvl env) -- See Note [Floating to the top] + is_con_app = isSaturatedConApp expr saves_alloc = isTopLvl dest_lvl && (escapes_value_lam || floatConsts env) -- Always float allocation out of a value lambda -- if it gets to top level - && (not strict_ctxt || is_hnf || is_bot_lam) -{- - && ( (floatConsts env && - (not strict_ctxt || is_hnf)) -- (FT1) and (FT2) - || (is_bot_lam && escapes_value_lam)) -- (FT3) --} + && (not strict_ctxt || is_con_app || is_bot_lam) + -- is_con_app: don't float PAPs to the top; they may well end + -- up getting eta-expanded and re-inlined + -- E.g. f = \x -> (++) ys + -- If we float, then eta-expand we get + -- lvl = (++) ys + -- f = \x \zs -> lvl zs + -- and now wei'll inline lvl. Silly. + hasFreeJoin :: LevelEnv -> DVarSet -> Bool -- Has a free join point which is not being floated to top level. ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1466,7 +1466,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env , occ_int_cxt = int_cxt } = isNotTopLevel top_lvl -- Get rid of allocation || (int_cxt==IsInteresting) -- Function is applied - || (early_phase && not (isConLikeUnfolding unf)) -- See early_phase + -- || (early_phase && not (isConLikeUnfolding unf)) -- See early_phase one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = IsInsideLam , occ_int_cxt = IsInteresting } @@ -1479,7 +1479,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env -- See Note [pre/postInlineUnconditionally in gentle mode] inline_prag = idInlinePragma bndr - early_phase = sePhase env /= FinalPhase +-- early_phase = sePhase env /= FinalPhase -- If we don't have this early_phase test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to ===================================== libraries/ghc-internal/src/GHC/Internal/Base.hs ===================================== @@ -1809,7 +1809,7 @@ build g = g (:) [] augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a] {-# INLINE [1] augment #-} -augment g xs = g (:) xs +augment g = g (:) {-# RULES "fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) . @@ -1975,7 +1975,7 @@ The rules for map work like this. "++/literal_utf8" forall x. (++) (unpackCStringUtf8# x) = unpackAppendCStringUtf8# x #-} {-# RULES -"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys +"++" [~1] forall xs. (++) xs = augment (\c n -> foldr c n xs) #-} ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -5,6 +5,7 @@ , MagicHash , UnboxedTuples , UnliftedFFITypes + , TypeApplications #-} {-# LANGUAGE CApiFFI #-} -- We believe we could deorphan this module, by moving lots of things @@ -1696,6 +1697,16 @@ showSignedFloat showPos p x = showParen (p > 6) (showChar '-' . showPos (-x)) | otherwise = showPos x + +-- Speicialise showSignedFloat for (a) the type and (b) the argument function +-- The particularly targets are the calls in `instance Show Float` and +-- `instance Show Double` +-- Specialising for both (a) and (b) is obviously more efficient; and if you +-- don't you find that the `x` argument is strict, but boxed, and that can cause +-- functions calling showSignedFloat to have box their argument. +{-# SPECIALISE showSignedFloat @Float showFloat #-} +{-# SPECIALISE showSignedFloat @Double showFloat #-} + {- We need to prevent over/underflow of the exponent in encodeFloat when called from scaleFloat, hence we clamp the scaling parameter. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bee78af5db225c26bb21254bc9cc9f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bee78af5db225c26bb21254bc9cc9f... You're receiving this email because of your account on gitlab.haskell.org.