mirror of
https://github.com/github/semantic.git
synced 2024-12-25 07:55:12 +03:00
Rename NonDetEff to NonDet
This commit is contained in:
parent
2bf23e7a08
commit
a8c9c815ef
@ -13,7 +13,7 @@ import Prologue
|
||||
-- | The effects necessary for caching analyses.
|
||||
type CachingEffects term value effects
|
||||
= Fresh -- For 'MonadFresh'.
|
||||
': NonDetEff -- For 'Alternative' and 'MonadNonDet'.
|
||||
': NonDet -- For 'Alternative' and 'MonadNonDet'.
|
||||
': Reader (CacheFor term value) -- The in-cache used as an oracle while converging on a result.
|
||||
': State (CacheFor term value) -- The out-cache used to record results in each iteration of convergence.
|
||||
': effects
|
||||
|
@ -71,8 +71,8 @@ newtype Evaluating term value effects a = Evaluating (Eff effects a)
|
||||
|
||||
deriving instance Member Fail effects => MonadFail (Evaluating term value effects)
|
||||
deriving instance Member Fresh effects => MonadFresh (Evaluating term value effects)
|
||||
deriving instance Member NonDetEff effects => Alternative (Evaluating term value effects)
|
||||
deriving instance Member NonDetEff effects => MonadNonDet (Evaluating term value effects)
|
||||
deriving instance Member NonDet effects => Alternative (Evaluating term value effects)
|
||||
deriving instance Member NonDet effects => MonadNonDet (Evaluating term value effects)
|
||||
|
||||
-- | Effects necessary for evaluating (whether concrete or abstract).
|
||||
type EvaluatingEffects term value
|
||||
|
@ -3,7 +3,7 @@ module Control.Effect where
|
||||
|
||||
import Control.Monad.Effect as Effect
|
||||
import Control.Monad.Effect.Fail
|
||||
import Control.Monad.Effect.NonDetEff
|
||||
import Control.Monad.Effect.NonDet
|
||||
import Control.Monad.Effect.Reader
|
||||
import Control.Monad.Effect.State
|
||||
import Control.Monad.Effect.Writer
|
||||
@ -58,10 +58,10 @@ instance Monoid w => RunEffect (Writer w) a where
|
||||
type Result (Writer w) a = (a, w)
|
||||
runEffect = runWriter
|
||||
|
||||
-- | 'NonDetEff' effects are interpreted into a nondeterministic set of result values.
|
||||
instance Ord a => RunEffect NonDetEff a where
|
||||
type Result NonDetEff a = Set a
|
||||
runEffect = runNonDetEff unit
|
||||
-- | 'NonDet' effects are interpreted into a nondeterministic set of result values.
|
||||
instance Ord a => RunEffect NonDet a where
|
||||
type Result NonDet a = Set a
|
||||
runEffect = runNonDet unit
|
||||
|
||||
-- | 'Resumable' effects are interpreted into 'Either' s.t. failures are in 'Left' and successful results are in 'Right'.
|
||||
instance RunEffect (Resumable exc v) a where
|
||||
|
@ -1,11 +1,11 @@
|
||||
{-# LANGUAGE TypeFamilies, TypeOperators, UndecidableInstances #-}
|
||||
module Control.Effect.NonDet
|
||||
( MonadNonDet(..)
|
||||
, NonDetEff
|
||||
, NonDet
|
||||
) where
|
||||
|
||||
import Control.Monad.Effect.Internal
|
||||
import Control.Monad.Effect.NonDetEff as NonDetEff
|
||||
import Control.Monad.Effect.NonDet as NonDet
|
||||
import Prologue
|
||||
|
||||
-- | 'Monad's offering local isolation of nondeterminism effects.
|
||||
@ -16,6 +16,6 @@ class (Alternative m, Monad m) => MonadNonDet m where
|
||||
-> m a -- ^ The computation to run locally-nondeterministically.
|
||||
-> m b -- ^ A _deterministic_ computation producing the 'Monoid'al accumulation of the _locally-nondeterministic_ result values.
|
||||
|
||||
-- | Effect stacks containing 'NonDetEff' offer a 'MonadNonDet' instance which implements 'gather' by interpreting the requests for nondeterminism locally, without removing 'NonDetEff' from the stack—i.e. the _capacity_ for nondeterminism is still present in the effect stack, but any local nondeterminism has been applied.
|
||||
instance (NonDetEff :< fs) => MonadNonDet (Eff fs) where
|
||||
gather = NonDetEff.gather
|
||||
-- | Effect stacks containing 'NonDet' offer a 'MonadNonDet' instance which implements 'gather' by interpreting the requests for nondeterminism locally, without removing 'NonDet' from the stack—i.e. the _capacity_ for nondeterminism is still present in the effect stack, but any local nondeterminism has been applied.
|
||||
instance (NonDet :< fs) => MonadNonDet (Eff fs) where
|
||||
gather = NonDet.gather
|
||||
|
@ -3,6 +3,7 @@ module Analysis.Go.Spec (spec) where
|
||||
|
||||
import Data.Abstract.Value
|
||||
import Data.Map
|
||||
import Data.Either
|
||||
|
||||
import SpecHelpers
|
||||
|
||||
|
2
vendor/effects
vendored
2
vendor/effects
vendored
@ -1 +1 @@
|
||||
Subproject commit b823e3bbb38154771e74fdf76515be3722269375
|
||||
Subproject commit 5bb3381c4cf70ed418b8138d69d051e1957ae2f3
|
Loading…
Reference in New Issue
Block a user