mirror of
https://github.com/github/semantic.git
synced 2024-12-22 06:11:49 +03:00
Add addExport and getExports to MonadEvaluator
This commit is contained in:
parent
4c1b74b49d
commit
15b073485e
@ -20,6 +20,7 @@ type DeadCodeEffects t v
|
||||
= '[ State (Dead t) -- The set of dead terms
|
||||
, Fail -- Failure with an error message
|
||||
, State (Store (LocationFor v) v) -- The heap
|
||||
, State (Set (Name, Name)) -- Set of exports
|
||||
, State (EnvironmentFor v) -- Global (imperative) environment
|
||||
, Reader (EnvironmentFor v) -- Local environment (e.g. binding over a closure)
|
||||
, Reader (Linker t) -- Cache of unevaluated modules
|
||||
|
@ -25,6 +25,7 @@ type EvaluationEffects t v
|
||||
= '[ Fail -- Failure with an error message
|
||||
, State (Store (LocationFor v) v) -- The heap
|
||||
, 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 (Linker t) -- Cache of unevaluated modules
|
||||
, State (Linker (EnvironmentFor v)) -- Cache of evaluated modules
|
||||
|
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE DataKinds, FunctionalDependencies, GeneralizedNewtypeDeriving, RankNTypes, StandaloneDeriving, UndecidableInstances #-}
|
||||
module Control.Abstract.Evaluator where
|
||||
|
||||
import Control.Applicative
|
||||
import Prologue
|
||||
import Control.Monad.Effect
|
||||
import Control.Monad.Effect.Fail
|
||||
import Control.Monad.Effect.Fresh
|
||||
@ -9,6 +9,8 @@ import Control.Monad.Effect.NonDetEff
|
||||
import Control.Monad.Effect.Reader
|
||||
import Control.Monad.Effect.State
|
||||
import Data.Abstract.Linker
|
||||
import Data.Abstract.FreeVariables (Name)
|
||||
import Data.Set as Set
|
||||
import Data.Abstract.Value
|
||||
import Prelude hiding (fail)
|
||||
|
||||
@ -26,6 +28,10 @@ class MonadFail m => MonadEvaluator term value m | m -> term, m -> value where
|
||||
-- | Update the global environment.
|
||||
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.
|
||||
askLocalEnv :: m (EnvironmentFor value)
|
||||
-- | 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
|
||||
, Reader (EnvironmentFor value)
|
||||
, State (Set (Name, Name))
|
||||
, State (EnvironmentFor value)
|
||||
, State (StoreFor value)
|
||||
, Reader (Linker term)
|
||||
@ -58,6 +65,9 @@ instance Members '[ Fail
|
||||
putGlobalEnv = Evaluator . put
|
||||
modifyGlobalEnv f = Evaluator (modify f)
|
||||
|
||||
addExport = Evaluator . modify . Set.insert
|
||||
getExports = Evaluator get
|
||||
|
||||
askLocalEnv = Evaluator ask
|
||||
localEnv f a = Evaluator (local f (runEvaluator a))
|
||||
|
||||
|
@ -57,7 +57,9 @@ instance ( FreeVariables t
|
||||
integer = pure . inj . Integer
|
||||
boolean = pure . inj . Boolean
|
||||
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'
|
||||
| Just (Boolean b) <- prj cond = if b then if' else else'
|
||||
|
Loading…
Reference in New Issue
Block a user