Skip to content

fix: beta reduction no longer duplicates a non-trivial argument (#167) #191

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
Unisay merged 1 commit into from
Jul 6, 2026
Merged

fix: beta reduction no longer duplicates a non-trivial argument (#167) #191

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
34 changes: 29 additions & 5 deletions lib/Language/PureScript/Backend/IR/Optimizer.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@ import Language.PureScript.Backend.IR.Types
, countFreeRefs
, getAnn
, isNonRecursiveLiteral
, lets
, literalBool
, rewriteExpBottomUpM
, substituteCopyM
Expand Down Expand Up @@ -395,14 +396,36 @@ reduceObjectProp =
fromMaybe (ObjectProp ann obj prop) (List.lookup prop (toList patches))
_ → Nothing

{- Note [Beta reduction and local inlining share an inlining guard]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'betaReduce' and 'inlineLocalBinding' decide whether to paste an expression
into its use sites by the same test: paste only when re-evaluating it cannot
multiply work — the expression is trivial ('isInlinableExpr': a Ref, a
literal, or an @inline-always node) or it is used at most once. Otherwise the
expression stays behind a single 'Let' binding.

The two rules must agree, because they hand work to each other. When
'betaReduce' declines to substitute a redex it rewrites it to
@let param = arg in body@ rather than duplicating @arg@ (in a strict language
that would repeat @arg@'s evaluation at every occurrence). That 'Let' is then
visited by 'inlineLocalBinding', which faces the identical choice for the same
expression. Because the guards match, it declines too, so the pair reaches a
fixpoint in one bottom-up pass instead of oscillating.
-}

-- (λx. M) N ===> M[x := N]
-- See Note [IR is assumed well-typed]
betaReduce ∷ RewriteRuleM SupplyM Ann
betaReduce = \case
App _ (Abs _ (ParamNamed _ param) body) r →
-- The λ is consumed by the rewrite, so the first inserted occurrence
-- of the argument may keep its binder names ('substituteMoveM').
Just <$> substituteMoveM (Local param) r body
App _ (Abs _ (ParamNamed paramAnn param) body) r
-- See Note [Beta reduction and local inlining share an inlining guard]
| isInlinableExpr r || countFreeRef (Local param) body <= 1 →
-- The λ is consumed by the rewrite, so the first inserted occurrence
-- of the argument may keep its binder names ('substituteMoveM').
Just <$> substituteMoveM (Local param) r body
| otherwise →
-- Bind the argument once; its evaluation now happens a single time.
pure . Just $ lets (Standalone (paramAnn, param, r) :| []) body
_ → pure Nothing

{- Note [Eta reduction is unsound]
Expand Down Expand Up @@ -518,7 +541,8 @@ inlineLocalBinding grouping (body, inlined) =
Standalone (_ann, Local → name, inlinee)
| occurrences > 0
, countFreeRef name inlinee == 0 -- no self-reference, see above
, isInlinableExpr inlinee || occurrences == 1 →
, -- See Note [Beta reduction and local inlining share an inlining guard]
isInlinableExpr inlinee || occurrences == 1 →
-- The binding survives until DCE drops it, so the inserted copy
-- must not reuse its binder names ('substituteCopyM').
(,Rewritten) <$> substituteCopyM name inlinee body
Expand Down
31 changes: 31 additions & 0 deletions test/Language/PureScript/Backend/IR/Optimizer/Spec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -107,6 +107,37 @@ spec = describe "IR Optimizer" do
original = abstraction (paramNamed param) (application m (refLocal param))
optimizedExpression original === original

-- Beta reduction must not paste a non-trivial argument into every
-- occurrence of the parameter, repeating its work at each use site in a
-- strict language; it let-binds the argument instead.
-- See Note [Beta reduction and local inlining share an inlining guard]
describe "beta reduction does not duplicate work (#167)" do
let m = moduleNameFromString "M"
x = Name "x"
-- An application: evaluating it twice would repeat the work.
nonTrivial = application (refImported m (Name "g")) (literalInt 1)

it "let-binds a non-trivial argument used more than once" do
let body = eq (refLocal x) (refLocal x)
original = application (abstraction (paramNamed x) body) nonTrivial
optimizedExpression original `shouldBe` let1 x nonTrivial body

it "still substitutes a trivial reference used more than once" do
let g = refImported m (Name "g")
body = eq (refLocal x) (refLocal x)
original = application (abstraction (paramNamed x) body) g
optimizedExpression original `shouldBe` eq g g

it "substitutes a non-trivial argument used exactly once" do
let original =
application (abstraction (paramNamed x) (refLocal x)) nonTrivial
optimizedExpression original `shouldBe` nonTrivial

it "discards a non-trivial argument that is never used" do
let original =
application (abstraction (paramNamed x) (literalInt 7)) nonTrivial
optimizedExpression original `shouldBe` literalInt 7

describe "folds record-literal projections" do
let foo = PropName "foo"
bar = PropName "bar"
Expand Down
37 changes: 11 additions & 26 deletions test/ps/output/Golden.Annotations.M2/golden.ir
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,42 +11,27 @@ UberModule
[
( Name "inlineIntoMe", Abs Nothing
( ParamNamed Nothing ( Name "i$0" ) )
( IfThenElse Nothing
( Eq Nothing
( LiteralInt Nothing 1 )
( IfThenElse Nothing
( Eq Nothing
( LiteralInt Nothing 1 )
( IfThenElse Nothing
( Let Nothing
( Standalone
( Nothing, Name "v$2", Let Nothing
( Standalone
( Nothing, Name "v$4", IfThenElse Nothing
( Eq Nothing ( LiteralInt Nothing 1 ) ( Ref Nothing ( Local ( Name "i$0" ) ) ) )
( LiteralInt Nothing 2 )
( Ref Nothing ( Local ( Name "i$0" ) ) )
)
) :| []
)
( LiteralInt Nothing 2 )
( IfThenElse Nothing
( Eq Nothing ( LiteralInt Nothing 1 ) ( Ref Nothing ( Local ( Name "i$0" ) ) ) )
( Eq Nothing ( LiteralInt Nothing 1 ) ( Ref Nothing ( Local ( Name "v$4" ) ) ) )
( LiteralInt Nothing 2 )
( Ref Nothing ( Local ( Name "i$0" ) ) )
( Ref Nothing ( Local ( Name "v$4" ) ) )
)
)
) :| []
)
( LiteralInt Nothing 2 )
( IfThenElse Nothing
( Eq Nothing
( LiteralInt Nothing 1 )
( IfThenElse Nothing
( Eq Nothing ( LiteralInt Nothing 1 ) ( Ref Nothing ( Local ( Name "i$0" ) ) ) )
( LiteralInt Nothing 2 )
( Ref Nothing ( Local ( Name "i$0" ) ) )
)
)
( Eq Nothing ( LiteralInt Nothing 1 ) ( Ref Nothing ( Local ( Name "v$2" ) ) ) )
( LiteralInt Nothing 2 )
( IfThenElse Nothing
( Eq Nothing ( LiteralInt Nothing 1 ) ( Ref Nothing ( Local ( Name "i$0" ) ) ) )
( LiteralInt Nothing 2 )
( Ref Nothing ( Local ( Name "i$0" ) ) )
)
( Ref Nothing ( Local ( Name "v$2" ) ) )
)
)
),
Expand Down
24 changes: 6 additions & 18 deletions test/ps/output/Golden.Annotations.M2/golden.lua
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,25 +12,13 @@ M.Golden_Annotations_M1_foreign = (function()
end)()
return {
inlineIntoMe = function(i_S_0)
if 1 == (function()
if 1 == (function()
local v_S_2 = (function()
local v_S_4 = (function()
if 1 == i_S_0 then return 2 else return i_S_0 end
end)() then
return 2
else
if 1 == i_S_0 then return 2 else return i_S_0 end
end
end)() then
return 2
else
if 1 == (function()
if 1 == i_S_0 then return 2 else return i_S_0 end
end)() then
return 2
else
if 1 == i_S_0 then return 2 else return i_S_0 end
end
end
end)()
if 1 == v_S_4 then return 2 else return v_S_4 end
end)()
if 1 == v_S_2 then return 2 else return v_S_2 end
end,
inlineIntoMe2 = M.Golden_Annotations_M1_foreign.dontInlineClosure(M.Golden_Annotations_M1_foreign.inlineMeLambda(M.Golden_Annotations_M1_foreign.inlineMeLambda(17)))
}
130 changes: 64 additions & 66 deletions test/ps/output/Golden.ArrayOfUnits.Test/golden.ir
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,7 @@ UberModule
( PropName "foldMap", Abs Nothing
( ParamNamed Nothing ( Name "dictMonoid" ) )
( Abs Nothing
( ParamNamed Nothing ( Name "f$885" ) )
( ParamNamed Nothing ( Name "f$884" ) )
( App Nothing
( App Nothing
( App Nothing
Expand All @@ -88,9 +88,9 @@ UberModule
)
)
( Abs Nothing
( ParamNamed Nothing ( Name "x$886" ) )
( ParamNamed Nothing ( Name "x$885" ) )
( Abs Nothing
( ParamNamed Nothing ( Name "acc$887" ) )
( ParamNamed Nothing ( Name "acc$886" ) )
( App Nothing
( App Nothing
( ObjectProp Nothing
Expand All @@ -106,11 +106,11 @@ UberModule
( PropName "append" )
)
( App Nothing
( Ref Nothing ( Local ( Name "f$885" ) ) )
( Ref Nothing ( Local ( Name "x$886" ) ) )
( Ref Nothing ( Local ( Name "f$884" ) ) )
( Ref Nothing ( Local ( Name "x$885" ) ) )
)
)
( Ref Nothing ( Local ( Name "acc$887" ) ) )
( Ref Nothing ( Local ( Name "acc$886" ) ) )
)
)
)
Expand Down Expand Up @@ -370,84 +370,82 @@ UberModule
)
( Abs Nothing
( ParamNamed Nothing ( Name "x$907" ) )
( Abs Nothing
( ParamNamed Nothing ( Name "b$895" ) )
( App Nothing
( App Nothing
( App Nothing
( App Nothing
( Let Nothing
( Standalone
( Nothing, Name "dictApply$892", App Nothing
( ObjectProp Nothing
( Ref Nothing
( Imported
( ModuleName "Effect" )
( Name "applicativeEffect" )
)
)
( PropName "Apply0" )
)
( Ref Nothing
( Imported ( ModuleName "Control.Apply" ) ( Name "apply" ) )
( Imported ( ModuleName "Prim" ) ( Name "undefined" ) )
)
) :| []
)
( Abs Nothing
( ParamNamed Nothing ( Name "a$893" ) )
( Abs Nothing
( ParamNamed Nothing ( Name "b$894" ) )
( App Nothing
( ObjectProp Nothing
( Ref Nothing
( Imported
( ModuleName "Effect" )
( Name "applicativeEffect" )
( App Nothing
( App Nothing
( Ref Nothing
( Imported ( ModuleName "Control.Apply" ) ( Name "apply" ) )
)
( Ref Nothing ( Local ( Name "dictApply$892" ) ) )
)
( PropName "Apply0" )
)
( Ref Nothing
( Imported ( ModuleName "Prim" ) ( Name "undefined" ) )
)
)
)
( App Nothing
( App Nothing
( ObjectProp Nothing
( App Nothing
( ObjectProp Nothing
( App Nothing
( ObjectProp Nothing
( App Nothing
( ObjectProp Nothing
( App Nothing
( ObjectProp Nothing
( Ref Nothing ( Local ( Name "dictApply$892" ) ) )
( PropName "Functor0" )
)
( Ref Nothing
( Imported
( ModuleName "Effect" )
( Name "applicativeEffect" )
( ModuleName "Prim" )
( Name "undefined" )
)
)
( PropName "Apply0" )
)
( Ref Nothing
( Imported ( ModuleName "Prim" ) ( Name "undefined" ) )
( PropName "map" )
)
( Abs Nothing ( ParamUnused Nothing )
( Abs Nothing
( ParamNamed Nothing ( Name "x$901" ) )
( Ref Nothing ( Local ( Name "x$901" ) ) )
)
)
( PropName "Functor0" )
)
( Ref Nothing
( Imported ( ModuleName "Prim" ) ( Name "undefined" ) )
)
)
( PropName "map" )
)
( Abs Nothing ( ParamUnused Nothing )
( Abs Nothing
( ParamNamed Nothing ( Name "x$902" ) )
( Ref Nothing ( Local ( Name "x$902" ) ) )
( Ref Nothing ( Local ( Name "a$893" ) ) )
)
)
( Ref Nothing ( Local ( Name "b$894" ) ) )
)
( App Nothing
( App Nothing
( Ref Nothing
( Imported
( ModuleName "Effect.Console" )
( Name "logShow" )
)
)
( LiteralObject Nothing
[
( PropName "show", Abs Nothing ( ParamUnused Nothing )
( LiteralString Nothing "unit" )
)
]
)
)
)
)
( App Nothing
( App Nothing
( Ref Nothing
( Imported ( ModuleName "Effect.Console" ) ( Name "logShow" ) )
)
( LiteralObject Nothing
[
( PropName "show", Abs Nothing ( ParamUnused Nothing )
( LiteralString Nothing "unit" )
)
( Ref Nothing ( Local ( Name "x$907" ) ) )
)
]
)
)
( Ref Nothing ( Local ( Name "b$895" ) ) )
( Ref Nothing ( Local ( Name "x$907" ) ) )
)
)
)
Expand Down Expand Up @@ -498,7 +496,7 @@ UberModule
( PropName "foldl" )
)
( Abs Nothing
( ParamNamed Nothing ( Name "c$372$882" ) )
( ParamNamed Nothing ( Name "c$372$881" ) )
( Abs Nothing ( ParamUnused Nothing )
( App Nothing
( App Nothing
Expand All @@ -515,7 +513,7 @@ UberModule
( PropName "one" )
)
)
( Ref Nothing ( Local ( Name "c$372$882" ) ) )
( Ref Nothing ( Local ( Name "c$372$881" ) ) )
)
)
)
Expand Down
Loading
Loading