From 239fc967b4dfd0eba6ca5b0a9e0d9a2d29e6ad5e Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Thu, 13 Nov 2025 21:38:52 +0100 Subject: Sparse: Maybe prevent another SpSparse introduction --- src/CHAD/AST/Sparse.hs | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/src/CHAD/AST/Sparse.hs b/src/CHAD/AST/Sparse.hs index 1cd5031..85f2882 100644 --- a/src/CHAD/AST/Sparse.hs +++ b/src/CHAD/AST/Sparse.hs @@ -201,16 +201,27 @@ sparsePlusS SF _ t (SpSparse sp1) sp2 k = emaybe (weakenExpr WSink a) (inj2 (evar IZ)) (plus (evar IZ) (evar (IS IZ)))) -sparsePlusS ST _ t (SpSparse sp1) sp2 k = - sparsePlusS ST ST t sp1 sp2 $ \sp3 (Inj inj1) (Inj inj2) plus -> - k (SpSparse sp3) - (Inj $ \a -> emaybe a (ENothing ext (applySparse sp3 (fromSMTy t))) (EJust ext (inj1 (evar IZ)))) - (Inj $ \b -> EJust ext (inj2 b)) - (\a b -> - elet b $ - emaybe (weakenExpr WSink a) - (EJust ext (inj2 (evar IZ))) - (EJust ext (plus (evar IZ) (evar (IS IZ))))) +sparsePlusS ST _ t (SpSparse sp1) sp2 k + | Just zero2 <- cheapZero (applySparse sp2 t) = + sparsePlusS ST ST t sp1 sp2 $ \sp3 (Inj inj1) (Inj inj2) plus -> + k sp3 + (Inj $ \a -> emaybe a (inj2 zero2) (inj1 (evar IZ))) + (Inj inj2) + (\a b -> + elet b $ + emaybe (weakenExpr WSink a) + (inj2 (evar IZ)) + (plus (evar IZ) (evar (IS IZ)))) + | otherwise = + sparsePlusS ST ST t sp1 sp2 $ \sp3 (Inj inj1) (Inj inj2) plus -> + k (SpSparse sp3) + (Inj $ \a -> emaybe a (ENothing ext (applySparse sp3 (fromSMTy t))) (EJust ext (inj1 (evar IZ)))) + (Inj $ \b -> EJust ext (inj2 b)) + (\a b -> + elet b $ + emaybe (weakenExpr WSink a) + (EJust ext (inj2 (evar IZ))) + (EJust ext (plus (evar IZ) (evar (IS IZ))))) sparsePlusS req1 req2 t sp1 (SpSparse sp2) k = sparsePlusS req2 req1 t (SpSparse sp2) sp1 $ \sp3 inj1 inj2 plus -> k sp3 inj2 inj1 (flip plus) -- cgit v1.2.3-70-g09d2