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

Define a single instance of MonadThrow.

Browse Source
This commit is contained in:
Rob Rix 2018-03-22 19:27:31 -04:00
parent 31c433fe02
commit 8530a288cd
2 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,7 +5,6 @@ module Analysis.Abstract.Evaluating
import Control.Abstract.Evaluator import Control.Abstract.Evaluator
import Control.Monad.Effect import Control.Monad.Effect
import Control.Monad.Effect.Resumable
import Data.Abstract.Configuration import Data.Abstract.Configuration
import qualified Data.Abstract.Environment as Env import qualified Data.Abstract.Environment as Env
import Data.Abstract.Evaluatable import Data.Abstract.Evaluatable
@ -40,9 +39,6 @@ type EvaluatingEffects term value
] ]
instance Members '[Resumable Prelude.String value] effects => MonadThrow Prelude.String value (Evaluating term value effects) where
throwException = raise . throwError
instance Members '[Fail, State (IntMap.IntMap term)] effects => MonadControl term (Evaluating term value effects) where instance Members '[Fail, State (IntMap.IntMap term)] effects => MonadControl term (Evaluating term value effects) where
label term = do label term = do
m <- raise get m <- raise get

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

@ -1,4 +1,4 @@
{-# LANGUAGE ConstrainedClassMethods, FunctionalDependencies #-} {-# LANGUAGE ConstrainedClassMethods, DataKinds, FunctionalDependencies, UndecidableInstances #-}
module Control.Abstract.Evaluator module Control.Abstract.Evaluator
( MonadEvaluator(..) ( MonadEvaluator(..)
, MonadEnvironment(..) , MonadEnvironment(..)
@ -17,6 +17,8 @@ module Control.Abstract.Evaluator
, EvaluateModule(..) , EvaluateModule(..)
) where ) where
import Control.Effect
import Control.Monad.Effect.Resumable
import Data.Abstract.Address import Data.Abstract.Address
import Data.Abstract.Configuration import Data.Abstract.Configuration
import qualified Data.Abstract.Environment as Env import qualified Data.Abstract.Environment as Env
@ -27,7 +29,7 @@ import Data.Abstract.Module
import Data.Abstract.ModuleTable import Data.Abstract.ModuleTable
import Data.Abstract.Value import Data.Abstract.Value
import Data.Semigroup.Reducer import Data.Semigroup.Reducer
import Prologue import Prologue hiding (throwError)
-- | A 'Monad' providing the basic essentials for evaluation. -- | A 'Monad' providing the basic essentials for evaluation.
-- --
@ -161,3 +163,6 @@ class Monad m => MonadThrow exc v m where
newtype EvaluateModule term = EvaluateModule (Module term) newtype EvaluateModule term = EvaluateModule (Module term)
deriving (Eq, Foldable, Functor, Ord, Show, Traversable) deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
instance (Effectful m, Members '[Resumable exc value] effects, Monad (m effects)) => MonadThrow exc value (m effects) where
throwException = raise . throwError