diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2025-06-18 13:57:45 +0200 |
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2025-06-18 13:57:45 +0200 |
| commit | 8bbc2d2867e3d0a4a1f2810b40e92175779822e1 (patch) | |
| tree | 7e7c522fb713d9180cb00b8a679dba665cd7d3ac /src/AST/UnMonoid.hs | |
| parent | a57ea7d00af8bf037a0a5d0b08cf7f5e432bf365 (diff) | |
Don't destroy effects in UnMonoid
Diffstat (limited to 'src/AST/UnMonoid.hs')
| -rw-r--r-- | src/AST/UnMonoid.hs | 6 |
1 files changed, 4 insertions, 2 deletions
diff --git a/src/AST/UnMonoid.hs b/src/AST/UnMonoid.hs index ac4d733..f5841e0 100644 --- a/src/AST/UnMonoid.hs +++ b/src/AST/UnMonoid.hs @@ -53,7 +53,8 @@ unMonoid = \case EError _ t s -> EError ext t s zero :: SMTy t -> Ex env (ZeroInfo t) -> Ex env t -zero SMTNil _ = ENil ext +-- don't destroy the effects! +zero SMTNil e = ELet ext e $ ENil ext zero (SMTPair t1 t2) e = ELet ext e $ EPair ext (zero t1 (EFst ext (EVar ext (typeOf e) IZ))) (zero t2 (ESnd ext (EVar ext (typeOf e) IZ))) @@ -67,7 +68,8 @@ zero (SMTScal t) _ = case t of STF64 -> EConst ext STF64 0.0 plus :: SMTy t -> Ex env t -> Ex env t -> Ex env t -plus SMTNil _ _ = ENil ext +-- don't destroy the effects! +plus SMTNil a b = ELet ext a $ ELet ext (weakenExpr WSink b) $ ENil ext plus (SMTPair t1 t2) a b = let t = STPair (fromSMTy t1) (fromSMTy t2) in ELet ext a $ |