From 5c756bc9eefcd98ed8448f491ddbc3197eaa4127 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Thu, 12 Feb 2026 20:40:49 +0100 Subject: Remove spurious work duplication in unMonoid EAccum --- src/CHAD/AST/UnMonoid.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'src/CHAD') diff --git a/src/CHAD/AST/UnMonoid.hs b/src/CHAD/AST/UnMonoid.hs index bb2af97..a249979 100644 --- a/src/CHAD/AST/UnMonoid.hs +++ b/src/CHAD/AST/UnMonoid.hs @@ -59,9 +59,11 @@ unMonoid = \case ERecompute _ e -> ERecompute ext (unMonoid e) EWith _ t a b -> EWith ext t (unMonoid a) (unMonoid b) EAccum _ t p eidx sp eval eacc -> - accumulateSparse (acPrjTy p t) sp eval $ \w prj2 idx2 val2 -> - acPrjCompose SAID p (weakenExpr w eidx) prj2 idx2 $ \prj' idx' -> - EAccum ext t prj' (unMonoid idx') (spDense (acPrjTy prj' t)) (unMonoid val2) (weakenExpr w (unMonoid eacc)) + elet (unMonoid eacc) $ + elet (weakenExpr WSink (unMonoid eidx)) $ + accumulateSparse (acPrjTy p t) sp (weakenExpr (WSink .> WSink) (unMonoid eval)) $ \w prj2 idx2 val2 -> + acPrjCompose SAID p (evar (w @> IZ)) prj2 idx2 $ \prj' idx' -> + EAccum ext t prj' (unMonoid idx') (spDense (acPrjTy prj' t)) (unMonoid val2) (evar (w @> IS IZ)) EError _ t s -> EError ext t s zero :: SMTy t -> Ex env (ZeroInfo t) -> Ex env t -- cgit v1.2.3-70-g09d2