purescript-lua · Unisay · Jul 23, 2026 · Jul 23, 2026
diff --git a/changelog.d/20260723_150000_unisay_collapse_boolean_match.md b/changelog.d/20260723_150000_unisay_collapse_boolean_match.md
@@ -0,0 +1,20 @@
+### Added
+
+- Boolean pattern matches — including every inlined `show` of a `Boolean` —
+  collapse to a two-way `if` (#223). A match on a `Boolean` compiled to a
+  three-way `if` with a synthesized default (`if a then … elseif false == a
+  then … else error("No patterns matched") end`), although `true`/`false`
+  already cover the type: the re-test was opaque to the optimizer and the dead
+  default was printed verbatim. Two additions reduce it. The boolean-equality
+  fold in `constantFolding` is completed — `false == b` and `b == false` fold
+  to `not b`, `b == true` to `b` (only the left-literal `true == b` folded
+  before) — and the new `propagateKnownCondIntoBranches` rule propagates a
+  variable condition's known value into its branches: inside `if c then t else
+  e` the variable `c` is `true` throughout `t` and `false` throughout `e`, so
+  its occurrences there are replaced with the matching literal and the existing
+  folds collapse the re-test, dropping the unreachable default. The `elseif
+  false ==` idiom disappears from every golden that carried it, and the
+  collapsed `show` bodies now clear the call-site inline budget — in the
+  `NumberIsNaN` golden that cascade dead-codes the whole `Ring` dictionary. A
+  genuinely partial match keeps its default: only a re-test of the same
+  variable folds. Eval goldens are unchanged.
diff --git a/lib/Language/PureScript/Backend/IR/Optimizer.hs b/lib/Language/PureScript/Backend/IR/Optimizer.hs
@@ -974,6 +974,7 @@ optimizedExpressionWithPastes pastes policy env =
         `thenRewrite` removeUnreachableThenBranch
         `thenRewrite` removeUnreachableElseBranch
         `thenRewrite` removeIfWithEqualBranches
+        `thenRewrite` propagateKnownCondIntoBranches
         `thenRewrite` flipNegatedIf
         `thenRewrite` reduceBooleanIf
         `thenRewrite` pushEqIntoIfBranches
@@ -1006,9 +1007,18 @@ constantFolding =
     Eq _ a b
       | Just result ← foldEqLiterals a b →
           Just $ literalBool result
+    -- The other operand must be of type Bool in each of the four cases
+    -- below; see Note [IR is assumed well-typed]. A false literal folds
+    -- to the negation (issue #223) — the shape a Boolean pattern match
+    -- re-tests its scrutinee with (@false == a@).
     Eq _ (LiteralBool _ True) b →
-      -- 'b' must be of type Bool; see Note [IR is assumed well-typed]
       Just b
+    Eq _ b (LiteralBool _ True) →
+      Just b
+    Eq _ (LiteralBool _ False) b →
+      Just (primNot b)
+    Eq _ b (LiteralBool _ False) →
+      Just (primNot b)
     -- See Note [IR primops] and Note [Folding primops follows Lua 5.1]
     PrimBinOp _ op a b → foldPrimBinOp op a b
     PrimNot _ a → foldPrimNot a
@@ -1966,6 +1976,41 @@ removeIfWithEqualBranches e =
           Just thenBranch
     _ → Nothing
 
+{- | Propagate a branch condition's known value into the branches (issue
+#223), the Boolean sibling of 'propagateKnownCtorThroughLet': inside
+@if c then t else e@ the variable @c@ is 'True' throughout @t@ and
+'False' throughout @e@, so its occurrences in the branches are replaced
+with the matching literal. The existing folds then finish the job: a
+Boolean pattern match compiles to a re-test of the scrutinee behind the
+first branch — @if a then "true" else (if false == a then "false" else
+error)@ — and with @a@ known 'False' in the else branch the re-test
+folds to a literal condition and 'removeUnreachableThenBranch' drops
+the synthesized default, collapsing the match to a two-way if.
+
+Only a variable condition propagates: an IR binding is immutable, so
+re-reading it in a branch is free and yields the value the test just
+observed, and replacing the read with a literal duplicates no work. The
+substitution licence is Note [IR is assumed well-typed]: @c@ is a
+'Bool', so truth of the test is equality with @true@. The substitution
+itself follows the GUC discipline of 'substituteCopyM' — no scope is
+threaded, which is exact under unique binders.
+
+Placed after 'removeIfWithEqualBranches': branches that are equal while
+still naming @c@ collapse to a single copy, which substituting the two
+literals first would unequalize. Fixpoint-safe: the rule fires only
+when a branch has a free occurrence of @c@ and leaves none behind, so
+it cannot re-fire on its own result, and a 'Ref' becomes a literal
+node-for-node, so the tree never grows.
+-}
+propagateKnownCondIntoBranches ∷ RewriteRuleM SupplyM Ann
+propagateKnownCondIntoBranches = \case
+  IfThenElse ann cond@(Ref _ name) thenBranch elseBranch
+    | countFreeRef name thenBranch + countFreeRef name elseBranch > 0 → do
+        thenBranch' ← substituteCopyM name (literalBool True) thenBranch
+        elseBranch' ← substituteCopyM name (literalBool False) elseBranch
+        pure . Just $ IfThenElse ann cond thenBranch' elseBranch'
+  _ → pure Nothing
+
 {- | Drop a negated condition by swapping the branches:
 @if not p then a else b@ ⟶ @if p then b else a@. Runs before
 'reduceBooleanIf' so that @if not p then False else True@ normalises to

diff --git a/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs b/test/Language/PureScript/Backend/IR/Optimizer/Spec.hs
@@ -59,6 +59,7 @@ import Language.PureScript.Backend.IR.Types
   , ctorId
   , dataArgumentByIndex
   , eq
+  , exception
   , getAnn
   , ifThenElse
   , isLiteral
@@ -1049,6 +1050,75 @@ spec = describe "IR Optimizer" do
       let original = ifThenElse p r (refLocal (Name "s"))
       optimizedExpression original `shouldBe` original
 
+  -- A pattern match on a Boolean compiles to a three-way if with a
+  -- synthesized default: the scrutinee is re-tested behind the first
+  -- branch (`false == a`) and the default is unreachable, since
+  -- true/false already cover a Boolean. The boolean-equality folds and
+  -- the known-condition propagation collapse it to a two-way if.
+  describe "collapses a Boolean pattern match to a two-way if (#223)" do
+    let m = moduleNameFromString "M"
+        a = refLocal (Name "a")
+        b = primBinOp PrimLt (refLocal (Name "x")) (refLocal (Name "y"))
+        deadDefault = exception "No patterns matched"
+
+    it "reduces False == b to not b" do
+      optimizedExpression (eq (literalBool False) b) `shouldBe` primNot b
+
+    it "reduces b == False to not b" do
+      optimizedExpression (eq b (literalBool False)) `shouldBe` primNot b
+
+    it "reduces b == True to b" do
+      optimizedExpression (eq b (literalBool True)) `shouldBe` b
+
+    it "still folds two boolean literals to a literal" do
+      optimizedExpression (eq (literalBool False) (literalBool False))
+        `shouldBe` literalBool True
+
+    it "reduces the three-way Boolean match to a two-way if" do
+      -- The shape every inlined `show` of a Boolean produces.
+      let original =
+            ifThenElse a (literalString "true") $
+              ifThenElse
+                (eq (literalBool False) a)
+                (literalString "false")
+                deadDefault
+      optimizedExpression original
+        `shouldBe` ifThenElse a (literalString "true") (literalString "false")
+
+    it "propagates the condition's truth into the then branch" do
+      -- if a then a else e: a is True throughout the then branch, and
+      -- the half-literal boolean-if fold finishes the collapse.
+      let e = refLocal (Name "e")
+      optimizedExpression (ifThenElse a a e)
+        `shouldBe` primBinOp PrimOr a e
+
+    it "keeps the default of a genuinely partial match" do
+      -- No second arm at all: the default is live and must survive.
+      let original = ifThenElse a (literalString "true") deadDefault
+      optimizedExpression original `shouldBe` original
+
+    it "keeps the default when the guard tests a different variable" do
+      -- The re-test folds only for the same variable; a different one
+      -- may genuinely be true, so the default stays reachable (the
+      -- equality fold and the negated-if flip still normalise it).
+      let c = refLocal (Name "c")
+          original =
+            ifThenElse a (literalString "true") $
+              ifThenElse
+                (eq (literalBool False) c)
+                (literalString "false")
+                deadDefault
+          expected =
+            ifThenElse a (literalString "true") $
+              ifThenElse c deadDefault (literalString "false")
+      optimizedExpression original `shouldBe` expected
+
+    it "prefers collapsing equal branches over propagating the condition" do
+      -- if a then f a else f a ≡ f a: substituting True/False into the
+      -- branches first would unequalize them and lose the collapse.
+      let fa = application (refImported m (Name "f")) a
+      optimizedExpression (ifThenElse a fa fa) `shouldBe` fa
+
   -- Case-of-case over the IfThenElse decision tree: a boolean-returning
   -- tree consumed in a strict position (an Eq against a literal, or the
   -- condition of another if) sits in expression position, where codegen