1
1
mirror of https://github.com/github/semantic.git synced 2024-11-27 12:57:49 +03:00

Add let-bindings.

This commit is contained in:
Rob Rix 2022-02-01 14:05:01 -05:00
parent b6fac248f1
commit 1f2b8a1490
No known key found for this signature in database
GPG Key ID: 2BE643E01DC032AE
3 changed files with 18 additions and 0 deletions

View File

@ -180,5 +180,9 @@ instance ( Has (A.Env A.PAddr) sig m
_ -> fail "expected Bool"
L (DString s) -> pure (String s <$ ctx)
L (DDie msg) -> fail (show (quote msg))
L (DLet n v b) -> do
addr <- A.alloc n
addr A..= v
A.bind n addr $ hdl (b v <$ ctx)
R other -> DomainC (alg (runDomain . hdl) other ctx)

View File

@ -23,6 +23,8 @@ module Analysis.Effect.Domain
, dstring
-- * Exceptions
, ddie
-- * Control flow
, dlet
-- * Domain effect
, Dom(..)
) where
@ -85,6 +87,12 @@ ddie :: Has (Dom val) sig m => val -> m val
ddie = send . DDie
-- Control flow
dlet :: Has (Dom val) sig m => Name -> val -> (val -> m val) -> m val
dlet n v b = send (DLet n v b)
-- Domain effect
data Dom val m k where
@ -97,3 +105,4 @@ data Dom val m k where
DIf :: val -> m a -> m a -> Dom val m a
DString :: Text -> Dom val m val
DDie :: val -> Dom val m val
DLet :: Name -> val -> (val -> m val) -> Dom val m val

View File

@ -244,4 +244,9 @@ instance ( Alternative m
L (DDie msg) -> fail (show msg)
L (DLet n v b) -> do
addr <- A.alloc n
addr A..= v
A.bind n addr $ hdl (b v <$ ctx)
R other -> DomainC (alg (runDomain . hdl) other ctx)