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:
parent
4c1b74b49d
commit
15b073485e
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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))
|
||||||
|
|
||||||
|
@ -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'
|
||||||
|
Loading…
Reference in New Issue
Block a user