1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00

Add addExport and getExports to MonadEvaluator

This commit is contained in:
joshvera 2018-03-07 10:03:45 -05:00
parent 4c1b74b49d
commit 15b073485e
4 changed files with 16 additions and 2 deletions

View File

@ -20,6 +20,7 @@ type DeadCodeEffects t v
= '[ State (Dead t) -- The set of dead terms = '[ State (Dead t) -- The set of dead terms
, Fail -- Failure with an error message , Fail -- Failure with an error message
, State (Store (LocationFor v) v) -- The heap , State (Store (LocationFor v) v) -- The heap
, State (Set (Name, Name)) -- Set of exports
, State (EnvironmentFor v) -- Global (imperative) environment , State (EnvironmentFor v) -- Global (imperative) environment
, Reader (EnvironmentFor v) -- Local environment (e.g. binding over a closure) , Reader (EnvironmentFor v) -- Local environment (e.g. binding over a closure)
, Reader (Linker t) -- Cache of unevaluated modules , Reader (Linker t) -- Cache of unevaluated modules

View File

@ -25,6 +25,7 @@ type EvaluationEffects t v
= '[ Fail -- Failure with an error message = '[ Fail -- Failure with an error message
, State (Store (LocationFor v) v) -- The heap , State (Store (LocationFor v) v) -- The heap
, State (EnvironmentFor v) -- Global (imperative) environment , State (EnvironmentFor v) -- Global (imperative) environment
, State (Set (Name, Name)) -- Set of exports
, Reader (EnvironmentFor v) -- Local environment (e.g. binding over a closure) , Reader (EnvironmentFor v) -- Local environment (e.g. binding over a closure)
, Reader (Linker t) -- Cache of unevaluated modules , Reader (Linker t) -- Cache of unevaluated modules
, State (Linker (EnvironmentFor v)) -- Cache of evaluated modules , State (Linker (EnvironmentFor v)) -- Cache of evaluated modules

View File

@ -1,7 +1,7 @@
{-# LANGUAGE DataKinds, FunctionalDependencies, GeneralizedNewtypeDeriving, RankNTypes, StandaloneDeriving, UndecidableInstances #-} {-# LANGUAGE DataKinds, FunctionalDependencies, GeneralizedNewtypeDeriving, RankNTypes, StandaloneDeriving, UndecidableInstances #-}
module Control.Abstract.Evaluator where module Control.Abstract.Evaluator where
import Control.Applicative import Prologue
import Control.Monad.Effect import Control.Monad.Effect
import Control.Monad.Effect.Fail import Control.Monad.Effect.Fail
import Control.Monad.Effect.Fresh import Control.Monad.Effect.Fresh
@ -9,6 +9,8 @@ import Control.Monad.Effect.NonDetEff
import Control.Monad.Effect.Reader import Control.Monad.Effect.Reader
import Control.Monad.Effect.State import Control.Monad.Effect.State
import Data.Abstract.Linker import Data.Abstract.Linker
import Data.Abstract.FreeVariables (Name)
import Data.Set as Set
import Data.Abstract.Value import Data.Abstract.Value
import Prelude hiding (fail) import Prelude hiding (fail)
@ -26,6 +28,10 @@ class MonadFail m => MonadEvaluator term value m | m -> term, m -> value where
-- | Update the global environment. -- | Update the global environment.
modifyGlobalEnv :: (EnvironmentFor value -> EnvironmentFor value) -> m () modifyGlobalEnv :: (EnvironmentFor value -> EnvironmentFor value) -> m ()
-- | Scope the set of exported symbols to the global environment
addExport :: (Name, Name) -> m ()
getExports :: m (Set (Name, Name))
-- | Retrieve the local environment. -- | Retrieve the local environment.
askLocalEnv :: m (EnvironmentFor value) askLocalEnv :: m (EnvironmentFor value)
-- | Run an action with a locally-modified environment. -- | Run an action with a locally-modified environment.
@ -48,6 +54,7 @@ class MonadFail m => MonadEvaluator term value m | m -> term, m -> value where
instance Members '[ Fail instance Members '[ Fail
, Reader (EnvironmentFor value) , Reader (EnvironmentFor value)
, State (Set (Name, Name))
, State (EnvironmentFor value) , State (EnvironmentFor value)
, State (StoreFor value) , State (StoreFor value)
, Reader (Linker term) , Reader (Linker term)
@ -58,6 +65,9 @@ instance Members '[ Fail
putGlobalEnv = Evaluator . put putGlobalEnv = Evaluator . put
modifyGlobalEnv f = Evaluator (modify f) modifyGlobalEnv f = Evaluator (modify f)
addExport = Evaluator . modify . Set.insert
getExports = Evaluator get
askLocalEnv = Evaluator ask askLocalEnv = Evaluator ask
localEnv f a = Evaluator (local f (runEvaluator a)) localEnv f a = Evaluator (local f (runEvaluator a))

View File

@ -57,7 +57,9 @@ instance ( FreeVariables t
integer = pure . inj . Integer integer = pure . inj . Integer
boolean = pure . inj . Boolean boolean = pure . inj . Boolean
string = pure . inj . Value.String string = pure . inj . Value.String
interface v = inj . Value.Interface v <$> getGlobalEnv interface v = inj . Value.Interface v <$> prunedEnv
where
prunedEnv = bindExports <$> getExports <*> getGlobalEnv
ifthenelse cond if' else' ifthenelse cond if' else'
| Just (Boolean b) <- prj cond = if b then if' else else' | Just (Boolean b) <- prj cond = if b then if' else else'