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
, string
, asString
, lam
, Domain(..)
-- * Re-exports
, Algebra
@ -23,6 +24,7 @@ import Control.Monad ((>=>))
import Control.Monad.Fail as Fail
import Data.Text (Text)
import GHC.Generics (Generic1)
import Syntax.Scope (Scope)
abstract :: Has (Domain term abstract) sig m => Intro term Name -> m abstract
abstract concrete = send (Abstract concrete pure)
@ -51,6 +53,10 @@ asString = concretize @term >=> \case
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
= Abstract (Intro term Name) (abstract -> 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
A.assign addr a'
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' <- eval f
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 = fromBody $ lam (named' "foo")
prog1 = fromBody $ Core.lam (named' "foo")
( named' "bar" :<- pure "foo"
>>>= Core.if' (pure "bar")
(Core.bool False)