Define a single, universal instance of MonadModuleTable.

src/Analysis/Abstract/BadAddresses.hs

@@ -7,7 +7,6 @@ import Prologue
 newtype BadAddresses m (effects :: [* -> *]) a = BadAddresses (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (BadAddresses m)
 deriving instance MonadEvaluator location term value effects m   => MonadEvaluator location term value effects (BadAddresses m)
 
 instance ( Effectful m

src/Analysis/Abstract/BadModuleResolutions.hs

@@ -8,7 +8,6 @@ import Prologue
 newtype BadModuleResolutions m (effects :: [* -> *]) a = BadModuleResolutions (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (BadModuleResolutions m)
 deriving instance MonadEvaluator location term value effects m   => MonadEvaluator location term value effects (BadModuleResolutions m)
 
 instance ( Effectful m

src/Analysis/Abstract/BadValues.hs

@@ -10,7 +10,6 @@ import Data.ByteString.Char8 (pack)
 newtype BadValues m (effects :: [* -> *]) a = BadValues (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (BadValues m)
 deriving instance MonadEvaluator location term value effects m   => MonadEvaluator location term value effects (BadValues m)
 
 instance ( Effectful m

src/Analysis/Abstract/BadVariables.hs

@@ -11,7 +11,6 @@ import Prologue
 newtype BadVariables m (effects :: [* -> *]) a = BadVariables (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (BadVariables m)
 deriving instance MonadEvaluator location term value effects m   => MonadEvaluator location term value effects (BadVariables m)
 
 instance ( Effectful m

src/Analysis/Abstract/Caching.hs

@@ -22,7 +22,6 @@ type CachingEffects location term value effects
 newtype Caching m (effects :: [* -> *]) a = Caching (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (Caching m)
 deriving instance MonadEvaluator location term value effects m   => MonadEvaluator location term value effects (Caching m)
 
 -- | Functionality used to perform caching analysis. This is not exported, and exists primarily for organizational reasons.

src/Analysis/Abstract/Collecting.hs

@@ -13,8 +13,6 @@ import Prologue
 newtype Collecting m (effects :: [* -> *]) a = Collecting (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (Collecting m)
-
 instance ( Effectful m
          , Member (Reader (Live location value)) effects
          , MonadEvaluator location term value effects m

src/Analysis/Abstract/Dead.hs

@@ -13,7 +13,6 @@ import Prologue
 newtype DeadCode m (effects :: [* -> *]) a = DeadCode (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (DeadCode m)
 deriving instance MonadEvaluator location term value effects m   => MonadEvaluator location term value effects (DeadCode m)
 
 -- | A set of “dead” (unreachable) terms.

src/Analysis/Abstract/Evaluating.hs

@@ -48,25 +48,6 @@ view :: Member (State (EvaluatorState location term value)) effects => Getting a
 view lens = raise (gets (^. lens))
 
 
-instance Members '[ Reader (ModuleTable [Module term])
-                  , State (EvaluatorState location term value)
-                  , Reader (SomeOrigin term)
-                  , Fail
-                  ] effects
-      => MonadModuleTable location term value effects (Evaluating location term value) where
-  getModuleTable = view _modules
-  putModuleTable = (_modules .=)
-
-  askModuleTable = raise ask
-  localModuleTable f a = raise (local f (lower a))
-
-  getLoadStack = view _loadStack
-  putLoadStack = (_loadStack .=)
-
-  currentModule = do
-    o <- raise ask
-    maybeFail "unable to get currentModule" $ withSomeOrigin (originModule @term) o
-
 instance Members (EvaluatingEffects location term value) effects
       => MonadEvaluator location term value effects (Evaluating location term value) where
   getConfiguration term = Configuration term mempty <$> getEnv <*> getHeap

src/Analysis/Abstract/ImportGraph.hs

@@ -57,7 +57,6 @@ style = (defaultStyle vertexName)
 newtype ImportGraphing m (effects :: [* -> *]) a = ImportGraphing (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (ImportGraphing m)
 deriving instance MonadEvaluator location term value effects m   => MonadEvaluator location term value effects (ImportGraphing m)
 
 

src/Analysis/Abstract/Quiet.hs

@@ -17,7 +17,6 @@ import Prologue
 newtype Quietly m (effects :: [* -> *]) a = Quietly (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (Quietly m)
 deriving instance MonadEvaluator location term value effects m   => MonadEvaluator location term value effects (Quietly m)
 
 instance ( Effectful m

src/Analysis/Abstract/Tracing.hs

@@ -16,7 +16,6 @@ import Prologue
 newtype Tracing (trace :: * -> *) m (effects :: [* -> *]) a = Tracing (m effects a)
   deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh)
 
-deriving instance MonadModuleTable location term value effects m => MonadModuleTable location term value effects (Tracing trace m)
 deriving instance MonadEvaluator location term value effects m   => MonadEvaluator location term value effects (Tracing trace m)
 
 instance ( Corecursive term

src/Control/Abstract/Evaluator.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstrainedClassMethods, FunctionalDependencies, RankNTypes, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE ConstrainedClassMethods, FunctionalDependencies, RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 module Control.Abstract.Evaluator
   ( MonadEvaluator(..)
   -- State
@@ -61,9 +61,10 @@ import Prologue
 class ( Effectful m
       , Member Fail effects
       , Member (Reader (Environment location value)) effects
+      , Member (Reader (ModuleTable [Module term])) effects
+      , Member (Reader (SomeOrigin term)) effects
       , Member (State (EvaluatorState location term value)) effects
-      , Monad (m effects)
-      , MonadModuleTable location term value effects m
+      , MonadFail (m effects)
       )
    => MonadEvaluator location term value (effects :: [* -> *]) m | m effects -> location term value where
   -- | Get the current 'Configuration' with a passed-in term.
@@ -255,6 +256,20 @@ class Monad (m effects) => MonadModuleTable location term value (effects :: [* -
   -- | Get the currently evaluating 'ModuleInfo'.
   currentModule :: m effects ModuleInfo
 
+instance (Monad (m effects), MonadEvaluator location term value effects m) => MonadModuleTable location term value effects m where
+  getModuleTable = view _modules
+  putModuleTable = (_modules .=)
+
+  askModuleTable = raise ask
+  localModuleTable f a = raise (local f (lower a))
+
+  getLoadStack = view _loadStack
+  putLoadStack = (_loadStack .=)
+
+  currentModule = do
+    o <- raise ask
+    maybeFail "unable to get currentModule" $ withSomeOrigin (originModule @term) o
+
 -- | Update the evaluated module table.
 modifyModuleTable :: MonadModuleTable location term value effects m => (ModuleTable (Environment location value, value) -> ModuleTable (Environment location value, value)) -> m effects ()
 modifyModuleTable f = do
@@ -284,7 +299,7 @@ instance (Monad (m effects), MonadEvaluator location term value effects m) => Mo
     _jumps .= IntMap.insert i term m
     pure i
 
-  goto label = IntMap.lookup label <$> view _jumps >>= maybe (raise (fail ("unknown label: " <> show label))) pure
+  goto label = IntMap.lookup label <$> view _jumps >>= maybe (fail ("unknown label: " <> show label)) pure
 
 
 throwResumable :: (Member (Resumable exc) effects, Effectful m) => exc v -> m effects v

src/Data/Abstract/Evaluatable.hs

@@ -262,9 +262,7 @@ evaluateModules :: MonadEvaluatable location term value effects m
 evaluateModules = fmap Prelude.head . evaluatePackageBody . Package.fromModules
 
 -- | Evaluate a given package.
-evaluatePackage :: ( Member (Reader (SomeOrigin term)) effects
-                   , MonadEvaluatable location term value effects m
-                   )
+evaluatePackage :: MonadEvaluatable location term value effects m
                 => Package term
                 -> m effects [value]
 evaluatePackage p = pushOrigin (packageOrigin p) (evaluatePackageBody (packageBody p))