github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00
Code Issues Projects Releases Wiki Activity

Add Call instance for Evaluatable

Browse Source
This commit is contained in:
joshvera 2018-02-21 18:15:12 -05:00
parent 4e02199e7e
commit 51ff316305
1 changed files with 30 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Data/Syntax/Expression.hs
View File

@ -2,14 +2,19 @@
{-# LANGUAGE TypeApplications #-}
module Data.Syntax.Expression where
import Data.Proxy
import Control.Monad.Effect
import Control.Monad.Effect.State
import Control.Monad.Effect.Address
import Control.Monad.Effect.Env
import Control.Monad.Effect.Fresh
import Control.Monad.Effect.Store
import Control.Monad.Effect.Fail
import Data.Abstract.Address
import Data.Abstract.Environment
import Data.Abstract.Eval
import qualified Data.Abstract.Eval2 as E2
import qualified Data.Abstract.Eval3 as E3
import Data.Abstract.FreeVariables
import Data.Abstract.Type as Type
import Data.Abstract.Value (Value, Closure(..))
@ -86,6 +91,31 @@ instance ( Ord l
E2.localEnv (const (foldr (uncurry envInsert) env bindings)) (E2.step body)
instance ( Ord l
, Semigroup (Cell l (Value l t)) -- 'assign'
, MonadStore (Value l t) (Eff es) -- 'alloc'
, Member (State (E3.Env' (Value l t))) es -- State Env
, MonadAddress l (Eff es) -- 'alloc'
, Member (E3.Eval (E3.Base t) t) es
, Member (E3.Eval (E3.Base t) (Value l t)) es
, Member Fail es
, E2.Recursive t
, E3.Evaluatable es t (Value l t) (E3.Base t)
) => E3.Evaluatable es t (Value l t) Call where
eval Call{..} = do
closure <- E3.step @(Value l t) callFunction
Closure names body env <- maybe (fail "expected a closure") pure (prj closure :: Maybe (Closure l t))
bindings <- for (zip names callParams) $ \(name, param) -> do
v <- E3.step param
a <- alloc name
assign a v
pure (name, a)
put (foldr (uncurry envInsert) env bindings)
transactionState (Proxy :: Proxy (Environment l (Value l t))) (E3.step body)
data Comparison a
= LessThan !a !a
| LessThanEqual !a !a