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

Move the Ord constraint on the location into the class methods requiring it.

Browse Source
This commit is contained in:
Rob Rix 2018-03-07 18:35:56 -05:00
parent 704f09083f
commit 6ed41a911c
2 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,6 +6,7 @@ import Control.Abstract.Evaluator
import Control.Monad.Effect.Writer
import Data.Abstract.Configuration
import Data.Semigroup.Reducer as Reducer
import Data.Abstract.Value
import Prologue
type Trace trace term value = trace (ConfigurationFor term value)
@ -27,6 +28,7 @@ instance ( Corecursive (TermFor m)
, Member (TracerFor trace m) (Effects m)
, MonadAnalysis m
, MonadEvaluator m
, Ord (LocationFor (ValueFor m))
, Recursive (TermFor m)
, Reducer (ConfigurationFor (TermFor m) (ValueFor m)) (TraceFor trace m)
)

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

@ -1,4 +1,4 @@
{-# LANGUAGE DataKinds, DefaultSignatures, GeneralizedNewtypeDeriving, RankNTypes, StandaloneDeriving, TypeFamilies, UndecidableInstances #-}
{-# LANGUAGE ConstrainedClassMethods, DataKinds, DefaultSignatures, GeneralizedNewtypeDeriving, RankNTypes, StandaloneDeriving, TypeFamilies, UndecidableInstances #-}
module Control.Abstract.Evaluator where
import Control.Abstract.Analysis
@ -18,7 +18,7 @@ import Prelude hiding (fail)
-- - environments binding names to addresses
-- - a heap mapping addresses to (possibly sets of) values
-- - tables of modules available for import
class (MonadFail m, Ord (LocationFor (ValueFor m))) => MonadEvaluator m where
class MonadFail m => MonadEvaluator m where
-- | Retrieve the global environment.
getGlobalEnv :: m (EnvironmentFor (ValueFor m))
-- | Update the global environment.
@ -45,11 +45,11 @@ class (MonadFail m, Ord (LocationFor (ValueFor m))) => MonadEvaluator m where
localModuleTable :: (Linker (TermFor m) -> Linker (TermFor m)) -> m a -> m a
-- | Retrieve the current root set.
askRoots :: m (Live (LocationFor (ValueFor m)) (ValueFor m))
askRoots :: Ord (LocationFor (ValueFor m)) => m (Live (LocationFor (ValueFor m)) (ValueFor m))
askRoots = pure mempty
-- | Get the current 'Configuration' with a passed-in term.
getConfiguration :: term -> m (Configuration (LocationFor (ValueFor m)) term (ValueFor m))
getConfiguration :: Ord (LocationFor (ValueFor m)) => term -> m (Configuration (LocationFor (ValueFor m)) term (ValueFor m))
getConfiguration term = Configuration term <$> askRoots <*> askLocalEnv <*> getStore
type EvaluatorEffects term value