github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 01:42:43 +03:00
Code Issues Projects Releases Wiki Activity

Move export into Env.

Browse Source
This commit is contained in:
Rob Rix 2018-05-30 15:11:24 -04:00
parent 6a3f4ba689
commit 0f6ad38a4e
1 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Control/Abstract/Environment.hs
View File

@ -22,9 +22,10 @@ module Control.Abstract.Environment
import Control.Abstract.Evaluator import Control.Abstract.Evaluator
import Data.Abstract.Environment (Environment) import Data.Abstract.Environment (Environment)
import Data.Abstract.Exports
import qualified Data.Abstract.Environment as Env import qualified Data.Abstract.Environment as Env
import Data.Abstract.Exports as Exports
import Data.Abstract.Name import Data.Abstract.Name
import Data.Semilattice.Lower
import Prologue import Prologue
-- | Retrieve the environment. -- | Retrieve the environment.
@ -69,9 +70,12 @@ data Env address return where
Push :: Env address () Push :: Env address ()
Pop :: Env address () Pop :: Env address ()
GetEnv :: Env address (Environment address) GetEnv :: Env address (Environment address)
Export :: Name -> Name -> Maybe address -> Env address ()
handleEnv :: forall address effects value result handleEnv :: forall address effects value result
. Member (State (Environment address)) effects . ( Member (State (Environment address)) effects
, Member (State (Exports address)) effects
)
=> Env address result => Env address result
-> Evaluator address value effects result -> Evaluator address value effects result
handleEnv = \case handleEnv = \case
@ -81,20 +85,23 @@ handleEnv = \case
Push -> modify (Env.push @address) Push -> modify (Env.push @address)
Pop -> modify (Env.pop @address) Pop -> modify (Env.pop @address)
GetEnv -> get GetEnv -> get
Export name alias addr -> modify (Exports.insert name alias addr)
runEnv :: Member (State (Environment address)) effects runEnv :: ( Member (State (Environment address)) effects
, Member (State (Exports address)) effects
)
=> Evaluator address value (Env address ': effects) a => Evaluator address value (Env address ': effects) a
-> Evaluator address value effects a -> Evaluator address value effects a
runEnv = interpret handleEnv runEnv = interpret handleEnv
reinterpretEnv :: Evaluator address value (Env address ': effects) a reinterpretEnv :: Evaluator address value (Env address ': effects) a
-> Evaluator address value (State (Environment address) ': effects) a -> Evaluator address value (State (Environment address) ': State (Exports address) ': effects) a
reinterpretEnv = reinterpret handleEnv reinterpretEnv = reinterpret2 handleEnv
runEnvState :: Environment address runEnvState :: Environment address
-> Evaluator address value (Env address ': effects) a -> Evaluator address value (Env address ': effects) a
-> Evaluator address value effects (a, Environment address) -> Evaluator address value effects (a, Environment address)
runEnvState initial = runState initial . reinterpretEnv runEnvState initial = fmap fst . runState lowerBound . runState initial . reinterpretEnv
-- | Errors involving the environment. -- | Errors involving the environment.