github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +03:00
Code Issues Projects Releases Wiki Activity

Add RunEffects usage back to Evaluating3.evalutate

Browse Source
This commit is contained in:
joshvera 2018-02-21 15:36:44 -05:00
parent db7f5b1cb8
commit e498f62fbb
1 changed files with 12 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Analysis/Abstract/Evaluating3.hs
View File

@ -1,7 +1,8 @@
{-# LANGUAGE ConstraintKinds, DataKinds, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, MultiParamTypeClasses #-} {-# LANGUAGE ConstraintKinds, DataKinds, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, MultiParamTypeClasses #-}
module Analysis.Abstract.Evaluating3 where module Analysis.Abstract.Evaluating3 where
import Control.Monad.Effect import Control.Effect
import Control.Monad.Effect hiding (run)
import Control.Monad.Effect.Fail import Control.Monad.Effect.Fail
import Control.Monad.Effect.Reader import Control.Monad.Effect.Reader
import Control.Monad.Effect.Store2 import Control.Monad.Effect.Store2
@ -27,23 +28,17 @@ type Evaluating term v
= '[ Fail -- For 'MonadFail'. = '[ Fail -- For 'MonadFail'.
, Store2 v -- For 'MonadStore'. , Store2 v -- For 'MonadStore'.
, State (Environment (LocationFor v) v) -- Environment State , State (Environment (LocationFor v) v) -- Environment State
, Eval (Base term) term -- , Eval (Base term) term
] ]
-- | Evaluate a term to a value. -- | Evaluate a term to a value.
evaluate :: forall term v. ( Ord v evaluate :: forall v term.
( Ord v
, Ord (LocationFor v) -- For 'MonadStore' , Ord (LocationFor v) -- For 'MonadStore'
, Recursive term , Recursive term
, Evaluatable '[] (Base term) term (Either Prelude.String v) , Evaluatable (Evaluating term v) term v (Base term)
, Evaluatable (Evaluating term v) (Base term) term v
) )
=> term => term
-> Either Prelude.String v -> Final (Evaluating term v) v
evaluate = run evaluate = run @(Evaluating term v)
. runEval . (fix (const (eval . project)))
. fmap fst
. flip runState mempty
. fmap fst
. flip runState mempty
. runFail
. (fix (const (eval . project :: term -> Eff (Evaluating term v) v)))