Revert "Revert "Revert "Parameterize the typeclasses by the list of effects."""

This reverts commit 81dc8c50484cf7c415eb3f754ca5fbb934517f2a.

src/Analysis/Abstract/Caching.hs

@@ -34,54 +34,53 @@ type CachingEffects term value effects
 type CacheFor m = Cache (LocationFor (ValueFor m)) (TermFor m) (ValueFor m)
 
 newtype CachingAnalysis m (effects :: [* -> *]) a = CachingAnalysis { runCachingAnalysis :: m effects a }
-  deriving (Alternative, Applicative, Functor, Monad, MonadFail, MonadFresh, MonadNonDet)
+  deriving (Alternative, Applicative, Functor, Monad, MonadEvaluator, MonadFail, MonadFresh, MonadNonDet)
 
 deriving instance Effectful effects (m effects) => Effectful effects (CachingAnalysis m effects)
 
-deriving instance MonadEvaluator effects m => MonadEvaluator effects (CachingAnalysis m)
 -- TODO: reabstract these later on
 
 type InCacheEffectFor  m = Reader (CacheFor m)
 type OutCacheEffectFor m = State  (CacheFor m)
 
-askCache :: (Effectful effects (m effects), Member (InCacheEffectFor m) effects) => CachingAnalysis m effects (CacheFor m)
+askCache :: (Effectful effects (m effects), Member (InCacheEffectFor (m effects)) effects) => CachingAnalysis m effects (CacheFor (m effects))
 askCache = lift ask
 
-localCache :: (Effectful effects (m effects), Member (InCacheEffectFor m) effects) => (CacheFor m -> CacheFor m) -> CachingAnalysis m effects a -> CachingAnalysis m effects a
+localCache :: (Effectful effects (m effects), Member (InCacheEffectFor (m effects)) effects) => (CacheFor (m effects) -> CacheFor (m effects)) -> CachingAnalysis m effects a -> CachingAnalysis m effects a
 localCache f a = lift (local f (lower a))
 
-asksCache :: (Functor (m effects), Effectful effects (m effects), Member (InCacheEffectFor m) effects) => (CacheFor m -> a) -> CachingAnalysis m effects a
+asksCache :: (Functor (m effects), Effectful effects (m effects), Member (InCacheEffectFor (m effects)) effects) => (CacheFor (m effects) -> a) -> CachingAnalysis m effects a
 asksCache f = f <$> askCache
 
-getsCache :: (Functor (m effects), Effectful effects (m effects), Member (OutCacheEffectFor m) effects) => (CacheFor m -> a) -> CachingAnalysis m effects a
+getsCache :: (Functor (m effects), Effectful effects (m effects), Member (OutCacheEffectFor (m effects)) effects) => (CacheFor (m effects) -> a) -> CachingAnalysis m effects a
 getsCache f = f <$> getCache
 
-getCache :: (Effectful effects (m effects), Member (OutCacheEffectFor m) effects) => CachingAnalysis m effects (CacheFor m)
+getCache :: (Effectful effects (m effects), Member (OutCacheEffectFor (m effects)) effects) => CachingAnalysis m effects (CacheFor (m effects))
 getCache = lift get
 
-putCache :: (Effectful effects (m effects), Member (OutCacheEffectFor m) effects) => CacheFor m -> CachingAnalysis m effects ()
+putCache :: (Effectful effects (m effects), Member (OutCacheEffectFor (m effects)) effects) => CacheFor (m effects) -> CachingAnalysis m effects ()
 putCache = lift . put
 
-modifyCache :: (Effectful effects (m effects), Member (OutCacheEffectFor m) effects, Monad (m effects)) => (CacheFor m -> CacheFor m) -> CachingAnalysis m effects ()
+modifyCache :: (Effectful effects (m effects), Member (OutCacheEffectFor (m effects)) effects, Monad (m effects)) => (CacheFor (m effects) -> CacheFor (m effects)) -> CachingAnalysis m effects ()
 modifyCache f = fmap f getCache >>= putCache
 
 -- | This instance coinductively iterates the analysis of a term until the results converge.
-instance ( Corecursive (TermFor m)
+instance ( Corecursive (TermFor (m effects))
-         , Ord (TermFor m)
+         , Ord (TermFor (m effects))
-         , Ord (ValueFor m)
+         , Ord (ValueFor (m effects))
-         , Ord (CellFor (ValueFor m))
+         , Ord (CellFor (ValueFor (m effects)))
-         , Ord (LocationFor (ValueFor m))
+         , Ord (LocationFor (ValueFor (m effects)))
          , Effectful effects (m effects)
          , MonadFresh (m effects)
          , MonadNonDet (m effects)
-         , Members (CachingEffectsFor m) effects
+         , Members (CachingEffectsFor (m effects)) effects
-         , Evaluatable (Base (TermFor m))
+         , Evaluatable (Base (TermFor (m effects)))
-         , Foldable (Cell (LocationFor (ValueFor m)))
+         , Foldable (Cell (LocationFor (ValueFor (m effects))))
-         , FreeVariables (TermFor m)
+         , FreeVariables (TermFor (m effects))
-         , MonadAnalysis effects m
+         , MonadAnalysis (m effects)
-         , Recursive (TermFor m)
+         , Recursive (TermFor (m effects))
          )
-         => MonadAnalysis effects (CachingAnalysis m) where
+         => MonadAnalysis (CachingAnalysis m effects) where
   analyzeTerm e = do
     c <- getConfiguration (embedSubterm e)
     -- Convergence here is predicated upon an Eq instance, not α-equivalence
@@ -115,25 +114,26 @@ converge f = loop
             loop x'
 
 -- | Nondeterministically write each of a collection of stores & return their associated results.
-scatter :: (Alternative (m effects), Foldable t, MonadEvaluator effects m) => t (a, Store (LocationFor (ValueFor m)) (ValueFor m)) -> m effects a
+scatter :: (Alternative m, Foldable t, MonadEvaluator m) => t (a, Store (LocationFor (ValueFor m)) (ValueFor m)) -> m a
 scatter = getAlt . foldMap (\ (value, store') -> Alt (putStore store' *> pure value))
 
 -- | Evaluation of a single iteration of an analysis, given an in-cache as an oracle for results and an out-cache to record computed results in.
-memoizeEval :: ( Ord (ValueFor m)
+memoizeEval :: ( Ord (ValueFor (m effects))
-               , Ord (TermFor m)
+               , Ord (TermFor (m effects))
-               , Ord (LocationFor (ValueFor m))
+               , Ord (LocationFor (ValueFor (m effects)))
-               , Ord (CellFor (ValueFor m))
+               , Ord (CellFor (ValueFor (m effects)))
                , Alternative (m effects)
-               , Corecursive (TermFor m)
+               , Corecursive (TermFor (m effects))
-               , FreeVariables (TermFor m)
+               , FreeVariables (TermFor (m effects))
-               , Foldable (Cell (LocationFor (ValueFor m)))
+               , Foldable (Cell (LocationFor (ValueFor (m effects))))
-               , Functor (Base (TermFor m))
+               , Functor (Base (TermFor (m effects)))
                , Effectful effects (m effects)
-               , Members (CachingEffectsFor m) effects
+               , Members (CachingEffectsFor (m effects)) effects
-               , Recursive (TermFor m)
+               , Recursive (TermFor (m effects))
-               , MonadAnalysis effects m
+               , MonadAnalysis (m effects)
+               -- , Semigroup (CellFor (ValueFor (m effects)))
                )
-            => SubtermAlgebra (Base (TermFor m)) (TermFor m) (CachingAnalysis m effects (ValueFor m))
+            => SubtermAlgebra (Base (TermFor (m effects))) (TermFor (m effects)) (CachingAnalysis m effects (ValueFor (m effects)))
 memoizeEval e = do
   c <- getConfiguration (embedSubterm e)
   cached <- getsCache (cacheLookup c)

src/Analysis/Abstract/Dead.hs

@@ -13,9 +13,8 @@ type DeadCode term = State (Dead term)
 
 -- | An analysis tracking dead (unreachable) code.
 newtype DeadCodeAnalysis m (effects :: [* -> *]) a = DeadCodeAnalysis { runDeadCodeAnalysis :: m effects a }
-  deriving (Applicative, Functor, Monad, MonadFail)
+  deriving (Applicative, Functor, Monad, MonadEvaluator, MonadFail)
 
-deriving instance MonadEvaluator effects m => MonadEvaluator effects (DeadCodeAnalysis m)
 
 -- | A set of “dead” (unreachable) terms.
 newtype Dead term = Dead { unDead :: Set term }
@@ -25,11 +24,11 @@ deriving instance Ord term => Reducer term (Dead term)
 deriving instance Effectful effects (m effects) => Effectful effects (DeadCodeAnalysis m effects)
 
 -- | Update the current 'Dead' set.
-killAll :: (Effectful effects (m effects), Member (State (Dead (TermFor m))) effects) => Dead (TermFor m) -> DeadCodeAnalysis m effects ()
+killAll :: (Effectful effects (m effects), Member (State (Dead (TermFor (m effects)))) effects) => Dead (TermFor (m effects)) -> DeadCodeAnalysis m effects ()
 killAll = lift . put
 
 -- | Revive a single term, removing it from the current 'Dead' set.
-revive :: (Effectful effects (m effects), Member (State (Dead (TermFor m))) effects) => Ord (TermFor m) => (TermFor m) -> DeadCodeAnalysis m effects ()
+revive :: (Effectful effects (m effects), Member (State (Dead (TermFor (m effects)))) effects) => Ord (TermFor (m effects)) => (TermFor (m effects)) -> DeadCodeAnalysis m effects ()
 revive t = lift (modify (Dead . delete t . unDead))
 
 -- | Compute the set of all subterms recursively.
@@ -37,16 +36,16 @@ subterms :: (Ord term, Recursive term, Foldable (Base term)) => term -> Dead ter
 subterms term = term `cons` para (foldMap (uncurry cons)) term
 
 
-instance ( Corecursive (TermFor m)
+instance ( Corecursive (TermFor (m effects))
          , Effectful effects (m effects)
-         , Foldable (Base (TermFor m))
+         , Foldable (Base (TermFor (m effects)))
-         , Member (State (Dead (TermFor m))) effects
+         , Member (State (Dead (TermFor (m effects)))) effects
-         , MonadAnalysis effects m
+         , MonadAnalysis (m effects)
-         , MonadEvaluator effects m
+         , MonadEvaluator (m effects)
-         , Ord (TermFor m)
+         , Ord (TermFor (m effects))
-         , Recursive (TermFor m)
+         , Recursive (TermFor (m effects))
          )
-         => MonadAnalysis effects (DeadCodeAnalysis m) where
+         => MonadAnalysis (DeadCodeAnalysis m effects) where
   analyzeTerm term = do
     revive (embedSubterm term)
     liftAnalyze analyzeTerm term

src/Analysis/Abstract/Evaluating.hs

@@ -21,29 +21,29 @@ import System.FilePath.Posix
 evaluate :: forall value term
          .  ( Evaluatable (Base term)
             , FreeVariables term
-            , MonadAddressable (LocationFor value) (EvaluatingEffects term value '[]) (Evaluating term value)
+            , MonadAddressable (LocationFor value) (Evaluating term value (EvaluatingEffects term value '[]))
-            , MonadValue value (EvaluatingEffects term value '[]) (Evaluating term value)
+            , MonadValue value (Evaluating term value (EvaluatingEffects term value '[]))
             , Recursive term
             )
          => term
          -> Final (EvaluatingEffects term value '[]) value
-evaluate = run . evaluateModule @(EvaluatingEffects term value '[]) @(Evaluating term value)
+evaluate = run . evaluateModule @(Evaluating term value (EvaluatingEffects term value '[]))
 
 -- | Evaluate terms and an entry point to a value.
 evaluates :: forall value term
           .  ( Evaluatable (Base term)
              , FreeVariables term
-             , MonadAddressable (LocationFor value) (EvaluatingEffects term value '[]) (Evaluating term value)
+             , MonadAddressable (LocationFor value) (Evaluating term value (EvaluatingEffects term value '[]))
-             , MonadValue value (EvaluatingEffects term value '[]) (Evaluating term value)
+             , MonadValue value (Evaluating term value (EvaluatingEffects term value '[]))
              , Recursive term
              )
           => [(Blob, term)] -- List of (blob, term) pairs that make up the program to be evaluated
           -> (Blob, term)   -- Entrypoint
           -> Final (EvaluatingEffects term value '[]) value
-evaluates pairs (_, t) = run (withModules pairs (evaluateModule @(EvaluatingEffects term value '[]) @(Evaluating term value) t))
+evaluates pairs (_, t) = run (withModules pairs (evaluateModule @(Evaluating term value (EvaluatingEffects term value '[])) t))
 
 -- | Run an action with the passed ('Blob', @term@) pairs available for imports.
-withModules :: (MonadAnalysis effects m, MonadEvaluator effects m) => [(Blob, TermFor m)] -> m effects a -> m effects a
+withModules :: (MonadAnalysis m, MonadEvaluator m) => [(Blob, TermFor m)] -> m a -> m a
 withModules pairs = localModuleTable (const moduleTable)
   where moduleTable = ModuleTable (Map.fromList (map (first (dropExtensions . blobPath)) pairs))
 
@@ -66,9 +66,9 @@ type EvaluatingEffects term value effects
  ': State  (ModuleTable value)    -- Cache of evaluated modules
  ': effects
 
-instance Members (EvaluatingEffects term value '[]) effects => MonadEvaluator effects (Evaluating term value) where
+instance Members (EvaluatingEffects term value '[]) effects => MonadEvaluator (Evaluating term value effects) where
-  type TermFor  (Evaluating term value) = term
+  type TermFor  (Evaluating term value effects) = term
-  type ValueFor (Evaluating term value) = value
+  type ValueFor (Evaluating term value effects) = value
 
   getGlobalEnv = lift get
   modifyGlobalEnv f = lift (modify f)
@@ -88,9 +88,9 @@ instance Members (EvaluatingEffects term value '[]) effects => MonadEvaluator ef
 instance ( Evaluatable (Base term)
          , FreeVariables term
          , Members (EvaluatingEffects term value '[]) effects
-         , MonadAddressable (LocationFor value) effects (Evaluating term value)
+         , MonadAddressable (LocationFor value) (Evaluating term value effects)
-         , MonadValue value effects (Evaluating term value)
+         , MonadValue value (Evaluating term value effects)
          , Recursive term
          )
-         => MonadAnalysis effects (Evaluating term value) where
+         => MonadAnalysis (Evaluating term value effects) where
   analyzeTerm = eval

src/Analysis/Abstract/Tracing.hs

@@ -18,29 +18,28 @@ type TracerFor trace m = Writer (TraceFor trace m)
 --   Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis.
 newtype TracingAnalysis (trace :: * -> *) m (effects :: [* -> *]) a
   = TracingAnalysis { runTracingAnalysis :: m effects a }
-  deriving (Applicative, Functor, Monad, MonadFail)
+  deriving (Applicative, Functor, Monad, MonadEvaluator, MonadFail)
 
 deriving instance Effectful effects (m effects) => Effectful effects (TracingAnalysis trace m effects)
-deriving instance MonadEvaluator effects m => MonadEvaluator effects (TracingAnalysis trace m)
 
-instance ( Corecursive (TermFor m)
+instance ( Corecursive (TermFor (m effects))
          , Effectful effects (m effects)
-         , Member (TracerFor trace m) effects
+         , Member (TracerFor trace (m effects)) effects
-         , MonadAnalysis effects m
+         , MonadAnalysis (m effects)
-         , MonadEvaluator effects m
+         , MonadEvaluator (m effects)
-         , Ord (LocationFor (ValueFor m))
+         , Ord (LocationFor (ValueFor (m effects)))
-         , Recursive (TermFor m)
+         , Recursive (TermFor (m effects))
-         , Reducer (ConfigurationFor (TermFor m) (ValueFor m)) (TraceFor trace m)
+         , Reducer (ConfigurationFor (TermFor (m effects)) (ValueFor (m effects))) (TraceFor trace (m effects))
          )
-         => MonadAnalysis effects (TracingAnalysis trace m) where
+         => MonadAnalysis (TracingAnalysis trace m effects) where
   analyzeTerm term = do
     config <- getConfiguration (embedSubterm term)
     trace (Reducer.unit config)
     liftAnalyze analyzeTerm term
 
 trace :: ( Effectful effects (m effects)
-         , Member (TracerFor trace m) effects
+         , Member (TracerFor trace (m effects)) effects
          )
-      => TraceFor trace m
+      => TraceFor trace (m effects)
       -> TracingAnalysis trace m effects ()
 trace = lift . tell

src/Control/Abstract/Addressable.hs

@@ -15,39 +15,39 @@ import Data.Semigroup.Reducer
 import Prelude hiding (fail)
 
 -- | Defines 'alloc'ation and 'deref'erencing of 'Address'es in a Store.
-class (Monad (m effects), Ord l, l ~ LocationFor (ValueFor m), Reducer (ValueFor m) (Cell l (ValueFor m))) => MonadAddressable l effects m where
+class (Monad m, Ord l, l ~ LocationFor (ValueFor m), Reducer (ValueFor m) (Cell l (ValueFor m))) => MonadAddressable l m where
   deref :: Address l (ValueFor m)
-        -> m effects (ValueFor m)
+        -> m (ValueFor m)
 
   alloc :: Name
-        -> m effects (Address l (ValueFor m))
+        -> m (Address l (ValueFor m))
 
 -- | Look up or allocate an address for a 'Name' free in a given term & assign it a given value, returning the 'Name' paired with the address.
 --
 --   The term is expected to contain one and only one free 'Name', meaning that care should be taken to apply this only to e.g. identifiers.
 lookupOrAlloc :: ( FreeVariables t
-                 , MonadAddressable (LocationFor a) effects m
+                 , MonadAddressable (LocationFor a) m
-                 , MonadEvaluator effects m
+                 , MonadEvaluator m
                  , a ~ ValueFor m
                  , Semigroup (CellFor a)
                  )
                  => t
                  -> a
                  -> Environment (LocationFor a) a
-                 -> m effects (Name, Address (LocationFor a) a)
+                 -> m (Name, Address (LocationFor a) a)
 lookupOrAlloc term = let [name] = toList (freeVariables term) in
                          lookupOrAlloc' name
   where
     -- | Look up or allocate an address for a 'Name' & assign it a given value, returning the 'Name' paired with the address.
     lookupOrAlloc' :: ( Semigroup (CellFor a)
-                      , MonadAddressable (LocationFor a) effects m
+                      , MonadAddressable (LocationFor a) m
                       , a ~ ValueFor m
-                      , MonadEvaluator effects m
+                      , MonadEvaluator m
                       )
                       => Name
                       -> a
                       -> Environment (LocationFor a) a
-                      -> m effects (Name, Address (LocationFor a) a)
+                      -> m (Name, Address (LocationFor a) a)
     lookupOrAlloc' name v env = do
       a <- maybe (alloc name) pure (envLookup name env)
       assign a v
@@ -55,20 +55,20 @@ lookupOrAlloc term = let [name] = toList (freeVariables term) in
 
 -- | Write a value to the given 'Address' in the 'Store'.
 assign :: ( Ord (LocationFor a)
-          , MonadEvaluator effects m
+          , MonadEvaluator m
           , a ~ ValueFor m
           , Reducer a (CellFor a)
           )
           => Address (LocationFor a) a
           -> a
-          -> m effects ()
+          -> m ()
 assign address = modifyStore . storeInsert address
 
 
 -- Instances
 
 -- | 'Precise' locations are always 'alloc'ated a fresh 'Address', and 'deref'erence to the 'Latest' value written.
-instance (Monad (m effects), MonadEvaluator effects m, LocationFor (ValueFor m) ~ Precise) => MonadAddressable Precise effects m where
+instance (Monad m, MonadEvaluator m, LocationFor (ValueFor m) ~ Precise) => MonadAddressable Precise m where
   deref = maybe uninitializedAddress (pure . unLatest) <=< flip fmap getStore . storeLookup
     where
       -- | Fail with a message denoting an uninitialized address (i.e. one which was 'alloc'ated, but never 'assign'ed a value before being 'deref'erenced).
@@ -79,7 +79,7 @@ instance (Monad (m effects), MonadEvaluator effects m, LocationFor (ValueFor m)
 
 
 -- | 'Monovariant' locations 'alloc'ate one 'Address' per unique variable name, and 'deref'erence once per stored value, nondeterministically.
-instance (Alternative (m effects), Ord (ValueFor m), LocationFor (ValueFor m) ~ Monovariant, Monad (m effects), MonadEvaluator effects m) => MonadAddressable Monovariant effects m where
+instance (Alternative m, Ord (ValueFor m), LocationFor (ValueFor m) ~ Monovariant, Monad m, MonadEvaluator m) => MonadAddressable Monovariant m where
   deref = asum . maybe [] (map pure . toList) <=< flip fmap getStore . storeLookup
 
   alloc = pure . Address . Monovariant

src/Control/Abstract/Analysis.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE KindSignatures, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE PolyKinds, TypeFamilies #-}
 module Control.Abstract.Analysis
 ( MonadAnalysis(..)
 , evaluateTerm
@@ -20,23 +20,23 @@ import Prologue
 -- | A 'Monad' in which one can evaluate some specific term type to some specific value type.
 --
 --   This typeclass is left intentionally unconstrained to avoid circular dependencies between it and other typeclasses.
-class (MonadEvaluator effects m, Recursive (TermFor m)) => MonadAnalysis effects m where
+class (MonadEvaluator m, Recursive (TermFor m)) => MonadAnalysis m where
   -- | Analyze a term using the semantics of the current analysis. This should generally only be called by definitions of 'evaluateTerm' and 'analyzeTerm' in this or other instances.
-  analyzeTerm :: SubtermAlgebra (Base (TermFor m)) (TermFor m) (m effects (ValueFor m))
+  analyzeTerm :: SubtermAlgebra (Base (TermFor m)) (TermFor m) (m (ValueFor m))
 
-  evaluateModule :: TermFor m -> m effects (ValueFor m)
+  evaluateModule :: TermFor m -> m (ValueFor m)
   evaluateModule = evaluateTerm
 
 -- | Evaluate a term to a value using the semantics of the current analysis.
 --
 --   This should always be called when e.g. evaluating the bodies of closures instead of explicitly folding either 'eval' or 'analyzeTerm' over subterms, except in 'MonadAnalysis' instances themselves. On the other hand, top-level evaluation should be performed using 'evaluateModule'.
-evaluateTerm :: MonadAnalysis effects m => TermFor m -> m effects (ValueFor m)
+evaluateTerm :: MonadAnalysis m => TermFor m -> m (ValueFor m)
 evaluateTerm = foldSubterms analyzeTerm
 
-liftAnalyze :: ( term ~ TermFor (  m)
+liftAnalyze :: ( term ~ TermFor (  m effects)
-               , term ~ TermFor (t m)
+               , term ~ TermFor (t m effects)
-               , value ~ ValueFor (  m)
+               , value ~ ValueFor (  m effects)
-               , value ~ ValueFor (t m)
+               , value ~ ValueFor (t m effects)
                , Coercible (  m effects value) (t m effects value)
                , Coercible (t m effects value) (  m effects value)
                , Functor (Base term)
@@ -45,10 +45,10 @@ liftAnalyze :: ( term ~ TermFor (  m)
             -> SubtermAlgebra (Base term) term (t m effects value)
 liftAnalyze analyze term = coerce (analyze (second coerce <$> term))
 
-liftEvaluate :: ( term ~ TermFor (  m)
+liftEvaluate :: ( term ~ TermFor (  m effects)
-                , term ~ TermFor (t m)
+                , term ~ TermFor (t m effects)
-                , value ~ ValueFor (  m)
+                , value ~ ValueFor (  m effects)
-                , value ~ ValueFor (t m)
+                , value ~ ValueFor (t m effects)
                 , Coercible (m effects value) (t m effects value)
                 )
              => (term ->   m effects value)

src/Control/Abstract/Evaluator.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstrainedClassMethods, DataKinds, KindSignatures, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE ConstrainedClassMethods, TypeFamilies #-}
 module Control.Abstract.Evaluator where
 
 import Data.Abstract.Configuration
@@ -14,41 +14,41 @@ import Prologue
 --   - environments binding names to addresses
 --   - a heap mapping addresses to (possibly sets of) values
 --   - tables of modules available for import
-class MonadFail (m effects) => MonadEvaluator (effects :: [* -> *]) m where
+class MonadFail m => MonadEvaluator m where
   type TermFor  m
   type ValueFor m
 
   -- | Retrieve the global environment.
-  getGlobalEnv :: m effects (EnvironmentFor (ValueFor m))
+  getGlobalEnv :: m (EnvironmentFor (ValueFor m))
   -- | Update the global environment.
-  modifyGlobalEnv :: (EnvironmentFor (ValueFor m) -> EnvironmentFor (ValueFor m)) -> m effects ()
+  modifyGlobalEnv :: (EnvironmentFor (ValueFor m) -> EnvironmentFor (ValueFor m)) -> m ()
 
   -- | Retrieve the local environment.
-  askLocalEnv :: m effects (EnvironmentFor (ValueFor m))
+  askLocalEnv :: m (EnvironmentFor (ValueFor m))
   -- | Run an action with a locally-modified environment.
-  localEnv :: (EnvironmentFor (ValueFor m) -> EnvironmentFor (ValueFor m)) -> m effects a -> m effects a
+  localEnv :: (EnvironmentFor (ValueFor m) -> EnvironmentFor (ValueFor m)) -> m a -> m a
 
   -- | Retrieve the heap.
-  getStore :: m effects (StoreFor (ValueFor m))
+  getStore :: m (StoreFor (ValueFor m))
   -- | Update the heap.
-  modifyStore :: (StoreFor (ValueFor m) -> StoreFor (ValueFor m)) -> m effects ()
+  modifyStore :: (StoreFor (ValueFor m) -> StoreFor (ValueFor m)) -> m ()
-  putStore :: StoreFor (ValueFor m) -> m effects ()
+  putStore :: StoreFor (ValueFor m) -> m ()
   putStore = modifyStore . const
 
   -- | Retrieve the table of evaluated modules.
-  getModuleTable :: m effects (ModuleTable (ValueFor m))
+  getModuleTable :: m (ModuleTable (ValueFor m))
   -- | Update the table of evaluated modules.
-  modifyModuleTable :: (ModuleTable (ValueFor m) -> ModuleTable (ValueFor m)) -> m effects ()
+  modifyModuleTable :: (ModuleTable (ValueFor m) -> ModuleTable (ValueFor m)) -> m ()
 
   -- | Retrieve the table of unevaluated modules.
-  askModuleTable :: m effects (ModuleTable (TermFor m))
+  askModuleTable :: m (ModuleTable (TermFor m))
   -- | Run an action with a locally-modified table of unevaluated modules.
-  localModuleTable :: (ModuleTable (TermFor m) -> ModuleTable (TermFor m)) -> m effects a -> m effects a
+  localModuleTable :: (ModuleTable (TermFor m) -> ModuleTable (TermFor m)) -> m a -> m a
 
   -- | Retrieve the current root set.
-  askRoots :: Ord (LocationFor (ValueFor m)) => m effects (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 :: Ord (LocationFor (ValueFor m)) => term -> m effects (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

src/Control/Abstract/Value.hs

@@ -16,40 +16,41 @@ import Prelude hiding (fail)
 -- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc).
 --
 --   This allows us to abstract the choice of whether to evaluate under binders for different value types.
-class (MonadEvaluator effects m, v ~ ValueFor m) => MonadValue v effects m where
+class (MonadEvaluator m, v ~ ValueFor m) => MonadValue v m where
   -- | Construct an abstract unit value.
-  unit :: m effects v
+  unit :: m v
 
   -- | Construct an abstract integral value.
-  integer :: Prelude.Integer -> m effects v
+  integer :: Prelude.Integer -> m v
 
   -- | Construct an abstract boolean value.
-  boolean :: Bool -> m effects v
+  boolean :: Bool -> m v
 
   -- | Construct an abstract string value.
-  string :: ByteString -> m effects v
+  string :: ByteString -> m v
 
   -- | Construct a floating-point value.
-  float :: Scientific -> m effects v
+  float :: Scientific -> m v
 
   -- | Eliminate boolean values. TODO: s/boolean/truthy
-  ifthenelse :: v -> m effects v -> m effects v -> m effects v
+  ifthenelse :: v -> m v -> m v -> m v
 
   -- | Evaluate an abstraction (a binder like a lambda or method definition).
-  abstract :: [Name] -> Subterm (TermFor m) (m effects v) -> m effects v
+  abstract :: [Name] -> Subterm (TermFor m) (m v) -> m v
   -- | Evaluate an application (like a function call).
-  apply :: v -> [Subterm (TermFor m) (m effects v)] -> m effects v
+  apply :: v -> [Subterm (TermFor m) (m v)] -> m v
 
 -- | Construct a 'Value' wrapping the value arguments (if any).
 instance ( FreeVariables t
-         , MonadAddressable location effects m
+         , MonadAddressable location m
-         , MonadAnalysis effects m
+         , MonadAnalysis m
          , TermFor m ~ t
          , ValueFor m ~ Value location t
+         , MonadEvaluator m
          , Recursive t
          , Semigroup (Cell location (Value location t))
          )
-         => MonadValue (Value location t) effects m where
+         => MonadValue (Value location t) m where
 
   unit    = pure $ inj Value.Unit
   integer = pure . inj . Integer
@@ -73,7 +74,7 @@ instance ( FreeVariables t
     localEnv (mappend bindings) (evaluateTerm body)
 
 -- | Discard the value arguments (if any), constructing a 'Type.Type' instead.
-instance (Alternative (m effects), MonadEvaluator effects m, MonadFresh (m effects), ValueFor m ~ Type) => MonadValue Type effects m where
+instance (Alternative m, MonadEvaluator m, MonadFresh m, ValueFor m ~ Type) => MonadValue Type m where
   abstract names (Subterm _ body) = do
     (env, tvars) <- foldr (\ name rest -> do
       a <- alloc name

src/Data/Abstract/Evaluatable.hs

@@ -31,12 +31,12 @@ class Evaluatable constr where
   eval :: ( term ~ TermFor m
           , value ~ ValueFor m
           , FreeVariables term
-          , MonadAddressable (LocationFor value) effects m
+          , MonadAddressable (LocationFor value) m
-          , MonadAnalysis effects m
+          , MonadAnalysis m
-          , MonadValue value effects m
+          , MonadValue value m
           )
-       => SubtermAlgebra constr term (m effects value)
+       => SubtermAlgebra constr term (m value)
-  default eval :: (MonadAnalysis effects m, Show1 constr) => SubtermAlgebra constr term (m effects value)
+  default eval :: (MonadFail m, Show1 constr) => SubtermAlgebra constr term (m value)
   eval expr = fail $ "Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr ""
 
 -- | If we can evaluate any syntax which can occur in a 'Union', we can evaluate the 'Union'.
@@ -74,10 +74,10 @@ instance Evaluatable [] where
 --
 -- Looks up the term's name in the cache of evaluated modules first, returns a value if found, otherwise loads/evaluates the module.
 require :: ( FreeVariables (TermFor m)
-           , MonadAnalysis effects m
+           , MonadAnalysis m
            )
         => TermFor m
-        -> m effects (ValueFor m)
+        -> m (ValueFor m)
 require term = getModuleTable >>= maybe (load term) pure . moduleTableLookup name
   where name = moduleName term
 
@@ -85,10 +85,10 @@ require term = getModuleTable >>= maybe (load term) pure . moduleTableLookup nam
 --
 -- Always loads/evaluates.
 load :: ( FreeVariables (TermFor m)
-        , MonadAnalysis effects m
+        , MonadAnalysis m
         )
      => TermFor m
-     -> m effects (ValueFor m)
+     -> m (ValueFor m)
 load term = askModuleTable >>= maybe notFound evalAndCache . moduleTableLookup name
   where name = moduleName term
         notFound = fail ("cannot find " <> show name)

src/Semantic/Util.hs

@@ -44,14 +44,14 @@ evaluateRubyFiles paths = do
   pure $ evaluates @RubyValue rest first
 
 -- Python
-typecheckPythonFile path = run . evaluateModule @(CachingEffects Python.Term Type (EvaluatingEffects Python.Term Type '[])) @(CachingAnalysis (Evaluating Python.Term Type)) . snd <$> parseFile pythonParser path
+typecheckPythonFile path = run . evaluateModule @(CachingAnalysis (Evaluating Python.Term Type) (CachingEffects Python.Term Type (EvaluatingEffects Python.Term Type '[]))) . snd <$> parseFile pythonParser path
 
-tracePythonFile path = run . evaluateModule @(Tracer [] Python.Term PythonValue ': (EvaluatingEffects Python.Term PythonValue '[])) @(TracingAnalysis [] (Evaluating Python.Term PythonValue)) . snd <$> parseFile pythonParser path
+tracePythonFile path = run . evaluateModule @(TracingAnalysis [] (Evaluating Python.Term PythonValue) (Tracer [] Python.Term PythonValue ': (EvaluatingEffects Python.Term PythonValue '[]))) . snd <$> parseFile pythonParser path
 
 type PythonTracer = TracingAnalysis [] (Evaluating Python.Term PythonValue)
 type PythonTracerEffects = DeadCode Python.Term ': Tracer [] Python.Term PythonValue ': EvaluatingEffects Python.Term PythonValue '[]
 
-evaluateDeadTracePythonFile path = run . evaluateModule @PythonTracerEffects @(DeadCodeAnalysis PythonTracer) . snd <$> parseFile pythonParser path
+evaluateDeadTracePythonFile path = run . evaluateModule @(DeadCodeAnalysis PythonTracer PythonTracerEffects) . snd <$> parseFile pythonParser path
 
 evaluatePythonFile path = evaluate @PythonValue . snd <$> parseFile pythonParser path