diff options
Diffstat (limited to 'src/CHAD/AST')
| -rw-r--r-- | src/CHAD/AST/UnMonoid.hs | 41 |
1 files changed, 18 insertions, 23 deletions
diff --git a/src/CHAD/AST/UnMonoid.hs b/src/CHAD/AST/UnMonoid.hs index d3cad25..bb2af97 100644 --- a/src/CHAD/AST/UnMonoid.hs +++ b/src/CHAD/AST/UnMonoid.hs @@ -102,36 +102,31 @@ deepZero (SMTScal t) _ = case t of plus :: SMTy t -> Ex env t -> Ex env t -> Ex env t -- don't destroy the effects! -plus SMTNil a b = ELet ext a $ ELet ext (weakenExpr WSink b) $ ENil ext +plus SMTNil a b = use a $ use b $ ENil ext plus (SMTPair t1 t2) a b = eunPair a $ \w1 a1 a2 -> eunPair (weakenExpr w1 b) $ \w2 b1 b2 -> EPair ext (plus t1 (weakenExpr w2 a1) b1) (plus t2 (weakenExpr w2 a2) b2) plus (SMTLEither t1 t2) a b = - let t = STLEither (fromSMTy t1) (fromSMTy t2) - in ELet ext a $ - ELet ext (weakenExpr WSink b) $ - ELCase ext (EVar ext t (IS IZ)) - (EVar ext t IZ) - (ELCase ext (EVar ext t (IS IZ)) - (EVar ext t (IS (IS IZ))) - (ELInl ext (fromSMTy t2) (plus t1 (EVar ext (fromSMTy t1) (IS IZ)) (EVar ext (fromSMTy t1) IZ))) - (EError ext t "plus l+r")) - (ELCase ext (EVar ext t (IS IZ)) - (EVar ext t (IS (IS IZ))) - (EError ext t "plus r+l") - (ELInr ext (fromSMTy t1) (plus t2 (EVar ext (fromSMTy t2) (IS IZ)) (EVar ext (fromSMTy t2) IZ)))) + elet b $ + elcase (weakenExpr WSink a) + (evar IZ) + (elcase (evar (IS IZ)) + (ELInl ext (fromSMTy t2) (evar IZ)) + (ELInl ext (fromSMTy t2) (plus t1 (evar (IS IZ)) (evar IZ))) + (EError ext (fromSMTy (SMTLEither t1 t2)) "splus ll+lr")) + (elcase (evar (IS IZ)) + (ELInr ext (fromSMTy t1) (evar IZ)) + (EError ext (fromSMTy (SMTLEither t1 t2)) "splus lr+ll") + (ELInr ext (fromSMTy t1) (plus t2 (evar (IS IZ)) (evar IZ)))) plus (SMTMaybe t) a b = - ELet ext b $ - EMaybe ext - (EVar ext (STMaybe (fromSMTy t)) IZ) - (EJust ext - (EMaybe ext - (EVar ext (fromSMTy t) IZ) - (plus t (EVar ext (fromSMTy t) (IS IZ)) (EVar ext (fromSMTy t) IZ)) - (EVar ext (STMaybe (fromSMTy t)) (IS IZ)))) - (weakenExpr WSink a) + elet b $ + emaybe (weakenExpr WSink a) + (evar IZ) + (emaybe (evar (IS IZ)) + (EJust ext (evar IZ)) + (EJust ext (plus t (evar (IS IZ)) (evar IZ)))) plus (SMTArr _ t) a b = ezipWith (plus t (EVar ext (fromSMTy t) (IS IZ)) (EVar ext (fromSMTy t) IZ)) a b |