From 65630468ccebeda0b0c37dfb8872e0f4ca2fdeae Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Sat, 1 Mar 2025 10:15:42 +0100
Subject: simplify: Halfway beta-reduce product projections in effectful
 context

---
 src/Simplify.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/Simplify.hs b/src/Simplify.hs
index 673b58c..fb858e7 100644
--- a/src/Simplify.hs
+++ b/src/Simplify.hs
@@ -60,8 +60,12 @@ simplify' = \case
         weakenExpr (WCopy WSink) (snd (simplify' b))
 
   -- beta rules for products
-  EFst _ (EPair _ e e') | not (hasAdds e') -> acted $ simplify' e
-  ESnd _ (EPair _ e' e) | not (hasAdds e') -> acted $ simplify' e
+  EFst _ (EPair _ e e')
+    | not (hasAdds e') -> acted $ simplify' e
+    | otherwise -> acted $ simplify' $ ELet ext e' (weakenExpr WSink e)
+  ESnd _ (EPair _ e' e)
+    | not (hasAdds e') -> acted $ simplify' e
+    | otherwise -> acted $ simplify' $ ELet ext e' (weakenExpr WSink e)
 
   -- beta rules for coproducts
   ECase _ (EInl _ _ e) rhs _ -> acted $ simplify' (ELet ext e rhs)
-- 
cgit v1.2.3-70-g09d2