github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 00:42:33 +03:00
Code Issues Projects Releases Wiki Activity

Define a smart constructor for constructing lambdas.

Browse Source
This commit is contained in:
Rob Rix 2019-12-19 11:11:47 -05:00
parent 1832212aea
commit 9f2a2fc819
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
2 changed files with 8 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
semantic-analysis/src/Analysis/Effect/Domain.hs
View File

@ -8,6 +8,7 @@ module Analysis.Effect.Domain
, asBool , asBool
, string , string
, asString , asString
, lam
, Domain(..) , Domain(..)
-- * Re-exports -- * Re-exports
, Algebra , Algebra
@ -23,6 +24,7 @@ import Control.Monad ((>=>))
import Control.Monad.Fail as Fail import Control.Monad.Fail as Fail
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics (Generic1) import GHC.Generics (Generic1)
import Syntax.Scope (Scope)
abstract :: Has (Domain term abstract) sig m => Intro term Name -> m abstract abstract :: Has (Domain term abstract) sig m => Intro term Name -> m abstract
abstract concrete = send (Abstract concrete pure) abstract concrete = send (Abstract concrete pure)
@ -51,6 +53,10 @@ asString = concretize @term >=> \case
other -> typeError "String" other other -> typeError "String" other
lam :: Has (Domain term abstract) sig m => Named (Scope () term Name) -> m abstract
lam = abstract . A.Lam
data Domain term abstract m k data Domain term abstract m k
= Abstract (Intro term Name) (abstract -> m k) = Abstract (Intro term Name) (abstract -> m k)
| Concretize abstract (Intro term Name -> m k) | Concretize abstract (Intro term Name -> m k)

4
semantic-core/src/Core/Eval.hs
View File

@ -61,7 +61,7 @@ eval Analysis{..} eval = \case
addr <- A.alloc @address n addr <- A.alloc @address n
A.assign addr a' A.assign addr a'
A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b)) A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
Lam (Named n b) -> A.abstract (I.Lam (Named n b)) Lam (Named n b) -> A.lam (Named n b)
f :$ a -> do f :$ a -> do
f' <- eval f f' <- eval f
A.concretize f' >>= \case A.concretize f' >>= \case
@ -115,7 +115,7 @@ eval Analysis{..} eval = \case
prog1 :: (Has Core sig t, Has Intro sig t) => File (t Name) prog1 :: (Has Core sig t, Has Intro sig t) => File (t Name)
prog1 = fromBody $ lam (named' "foo") prog1 = fromBody $ Core.lam (named' "foo")
( named' "bar" :<- pure "foo" ( named' "bar" :<- pure "foo"
>>>= Core.if' (pure "bar") >>>= Core.if' (pure "bar")
(Core.bool False) (Core.bool False)