github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-24 07:25:44 +03:00
Code Issues Projects Releases Wiki Activity

Implement localEnv with State rather than Reader.

Browse Source
This commit is contained in:
Patrick Thomson 2018-03-16 12:48:19 -04:00
parent bd24166d0f
commit e67590cfe6
2 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Analysis/Abstract/Evaluating.hs
View File

@ -13,6 +13,7 @@ import Control.Monad.Effect.NonDet
import Control.Monad.Effect.Reader
import Control.Monad.Effect.State
import Data.Abstract.Configuration
import Data.Abstract.Environment
import Data.Abstract.Evaluatable
import Data.Abstract.ModuleTable
import Data.Abstract.Value
@ -78,8 +79,7 @@ deriving instance Member NonDetEff effects => MonadNonDet (Evaluating term value
-- | Effects necessary for evaluating (whether concrete or abstract).
type EvaluatingEffects term value
= '[ Fail -- Failure with an error message
, Reader (EnvironmentFor value) -- Local environment (e.g. binding over a closure)
, State (EnvironmentFor value) -- Global (imperative) environment
, State (EnvironmentFor value) -- Environments (both local and global)
, State (HeapFor value) -- The heap
, Reader (ModuleTable [term]) -- Cache of unevaluated modules
, State (ModuleTable (EnvironmentFor value)) -- Cache of evaluated modules
@ -96,7 +96,7 @@ instance Members '[Fail, State (IntMap.IntMap term)] effects => MonadControl ter
goto label = IntMap.lookup label <$> raise get >>= maybe (fail ("unknown label: " <> show label)) pure
instance Members '[State (ExportsFor value), Reader (EnvironmentFor value), State (EnvironmentFor value)] effects => MonadEnvironment value (Evaluating term value effects) where
instance Members '[State (ExportsFor value), State (EnvironmentFor value)] effects => MonadEnvironment value (Evaluating term value effects) where
getGlobalEnv = raise get
putGlobalEnv = raise . put
withGlobalEnv s = raise . localState s . lower
@ -105,8 +105,11 @@ instance Members '[State (ExportsFor value), Reader (EnvironmentFor value), Stat
putExports = raise . put
withExports s = raise . localState s . lower
askLocalEnv = raise ask
localEnv f a = raise (local f (lower a))
askLocalEnv = raise get
localEnv f a = do
modifyGlobalEnv (f . envPush)
result <- a
result <$ modifyGlobalEnv envPop
instance Member (State (HeapFor value)) effects => MonadHeap value (Evaluating term value effects) where
getHeap = raise get

7
src/Data/Abstract/Environment.hs
View File

@ -27,6 +27,13 @@ instance Monoid (Environment l a) where
mappend = (<>)
mempty = Environment (mempty :| [])
envPush :: Environment l a -> Environment l a
envPush (Environment (a :| as)) = Environment (mempty :| a : as)
envPop :: Environment l a -> Environment l a
envPop (Environment (_ :| [])) = mempty
envPop (Environment (_ :| a : as)) = Environment (a :| as)
-- TODO: Test the flattening behavior
envPairs :: Environment l a -> [(Name, Address l a)]
envPairs = Map.toList . fold . unEnvironment