1
1
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:
joshvera 2018-03-22 10:35:25 -04:00
parent 2bf23e7a08
commit a8c9c815ef
6 changed files with 15 additions and 14 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

@ -1 +1 @@
Subproject commit b823e3bbb38154771e74fdf76515be3722269375
Subproject commit 5bb3381c4cf70ed418b8138d69d051e1957ae2f3