github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-13 03:15:45 +03:00
Code Issues Projects Releases Wiki Activity

Return effects store values

Browse Source
This commit is contained in:
joshvera 2018-09-26 13:57:09 -05:00
parent 020a179b11
commit 910ba23e6a
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -40,18 +40,18 @@ deriving instance Member (Lift IO) effects => MonadIO (Evaluator address value e
-- Effects
-- | An effect for explicitly returning out of a function/method body.
newtype Return address = Return { unReturn :: address }
newtype Return value = Return { unReturn :: value }
deriving (Eq, Ord, Show)
earlyReturn :: Member (Exc (Return address)) effects
=> address
-> Evaluator address value effects address
earlyReturn :: Member (Exc (Return value)) effects
=> value
-> Evaluator address value effects value
earlyReturn = throwError . Return
catchReturn :: (Member (Exc (Return address)) effects, Effectful (m address value)) => m address value effects address -> m address value effects address
catchReturn :: (Member (Exc (Return value)) effects, Effectful (m address value)) => m address value effects value -> m address value effects value
catchReturn = Eff.raiseHandler (handleError (\ (Return addr) -> pure addr))
runReturn :: (Effectful (m address value), Effects effects) => m address value (Exc (Return address) ': effects) address -> m address value effects address
runReturn :: (Effectful (m address value), Effects effects) => m address value (Exc (Return value) ': effects) value -> m address value effects value
runReturn = Eff.raiseHandler (fmap (either unReturn id) . runError)