github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-04 13:34:31 +03:00
Code Issues Projects Releases Wiki Activity

modifyModuleTable is strict in the new table.

Browse Source
This commit is contained in:
Rob Rix 2018-03-12 15:23:07 -04:00
parent 23cc1eafc4
commit db80ec7afa
2 changed files with 8 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -90,7 +90,7 @@ instance Member (State (StoreFor value)) effects => MonadStore value (Evaluating
instance Members '[Reader (ModuleTable term), State (ModuleTable (EnvironmentFor value))] effects => MonadModuleTable term value (Evaluating term value effects) where
getModuleTable = raise get
modifyModuleTable f = raise (modify f)
putModuleTable = raise . put
askModuleTable = raise ask
localModuleTable f a = raise (local f (lower a))

9
src/Control/Abstract/Evaluator.hs
View File

@ -68,10 +68,15 @@ assign address = modifyStore . storeInsert address
class Monad m => MonadModuleTable term value m | m -> term, m -> value where
-- | Retrieve the table of evaluated modules.
getModuleTable :: m (ModuleTable (EnvironmentFor value))
-- | Update the table of evaluated modules.
modifyModuleTable :: (ModuleTable (EnvironmentFor value) -> ModuleTable (EnvironmentFor value)) -> m ()
-- | Set the table of evaluated modules.
putModuleTable :: ModuleTable (EnvironmentFor value) -> m ()
-- | Retrieve the table of unevaluated modules.
askModuleTable :: m (ModuleTable term)
-- | Run an action with a locally-modified table of unevaluated modules.
localModuleTable :: (ModuleTable term -> ModuleTable term) -> m a -> m a
modifyModuleTable :: MonadModuleTable term value m => (ModuleTable (EnvironmentFor value) -> ModuleTable (EnvironmentFor value)) -> m ()
modifyModuleTable f = do
table <- getModuleTable
putModuleTable $! f table