Simon Peyton Jones pushed to branch wip/T26831 at Glasgow Haskell Compiler / GHC Commits: 2655e4f2 by Simon Peyton Jones at 2026-03-12T17:43:18+00:00 Immprove lambda handling in Prep All Lam in `body` rather than just `rhs`; indeed collapse the two. Then CoreToStg creates the lambda if needed - - - - - 4 changed files: - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - testsuite/tests/simplCore/should_compile/T15205.stderr Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -794,6 +794,7 @@ classOpSize opts cls top_args (dict_arg:other_val_args) arg_discount (Var dict) | dict `elem` top_args = unitBag (dict, dict_discount) arg_discount _ = emptyBag +-- TODO: document this change! dict_discount | null other_val_args = unfoldingDictDiscount opts | otherwise = unfoldingDictDiscount opts + unfoldingFunAppDiscount opts ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -420,16 +420,22 @@ coreToStgExpr expr@(App _ _) res_ty = exprType expr (app_head, args, ticks) = myCollectArgs expr res_ty -coreToStgExpr expr@(Lam _ _) - = let - (args, body) = myCollectBinders expr - in - case filterStgBinders args of - - [] -> coreToStgExpr body - - _ -> pprPanic "coretoStgExpr" $ - text "Unexpected value lambda:" $$ ppr expr +coreToStgExpr expr@(Lam {}) + | null val_bndrs + = coreToStgExpr body + | otherwise + = do { body' <- extendVarEnvCts [ (a, LambdaBound) | a <- val_bndrs ] $ + coreToStgExpr body + ; let body_ty = exprType body + fun_ty = mkLamTypes bndrs body_ty + rhs = StgRhsClosure noExtFieldSilent currentCCS + ReEntrant val_bndrs body' body_ty + tmp_fun = mkTemplateLocal 0 fun_ty + ; return (StgLet noExtFieldSilent (StgNonRec tmp_fun rhs) $ + StgApp tmp_fun []) } + where + (bndrs, body) = myCollectBinders expr + val_bndrs = filterStgBinders bndrs coreToStgExpr (Tick tick expr) = do ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -925,6 +925,7 @@ cpeBody env expr rhsToBody :: CorePrepEnv -> CpeRhs -> UniqSM (Floats, CpeBody) -- Remove top level lambdas by let-binding +{- rhsToBody env (Tick t expr) | tickishScoped t == NoScope -- only float out of non-scoped annotations = do { (floats, expr') <- rhsToBody env expr @@ -946,6 +947,7 @@ rhsToBody env expr@(Lam {}) -- See Note [No eta reduction needed in rhsToBody] ; return (unitFloat float, Var fn) } where (bndrs,_) = collectBinders expr +-} rhsToBody _env expr = return (emptyFloats, expr) ===================================== testsuite/tests/simplCore/should_compile/T15205.stderr ===================================== @@ -10,7 +10,7 @@ f :: forall a b. C a b => a -> b Str=<1P(A,1C(1,C(1,L)))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [30 0] 40 0}] + Guidance=IF_ARGS [90 0] 40 0}] f = \ (@a) (@b) ($dC :: C a b) (x :: a) -> op @a @b $dC x x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2655e4f2bac7cb4576058e32064017ae... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2655e4f2bac7cb4576058e32064017ae... You're receiving this email because of your account on gitlab.haskell.org.