diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2026-02-12 20:40:49 +0100 |
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2026-02-12 20:40:49 +0100 |
| commit | 5c756bc9eefcd98ed8448f491ddbc3197eaa4127 (patch) | |
| tree | a3a116917dd5f135b35e6f9d0d92cd05767d5f92 /src/CHAD/AST/UnMonoid.hs | |
| parent | 4728c3ac5e577f411b4579ee78648f04f9269a30 (diff) | |
Remove spurious work duplication in unMonoid EAccum
Diffstat (limited to 'src/CHAD/AST/UnMonoid.hs')
| -rw-r--r-- | src/CHAD/AST/UnMonoid.hs | 8 |
1 files changed, 5 insertions, 3 deletions
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 |