Give Interpreter a type family for the result type.

src/Analysis/Abstract/BadAddresses.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint
 module Analysis.Abstract.BadAddresses where
 
@@ -12,13 +12,14 @@ newtype BadAddresses m (effects :: [* -> *]) a = BadAddresses { runBadAddresses
 deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (BadAddresses m)
 deriving instance MonadAnalysis location term value effects m => MonadAnalysis location term value effects (BadAddresses m)
 
-instance ( Interpreter effects result rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          , AbstractHole value
          , Monoid (Cell location value)
          , Show location
          )
-      => Interpreter (Resumable (AddressError location value) ': effects) result rest (BadAddresses m) where
+      => Interpreter (Resumable (AddressError location value) ': effects) (BadAddresses m) where
+  type Result (Resumable (AddressError location value) ': effects) (BadAddresses m) result = Result effects m result
   interpret
     = interpret
     . runBadAddresses

src/Analysis/Abstract/BadModuleResolutions.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint
 module Analysis.Abstract.BadModuleResolutions where
 
@@ -12,10 +12,11 @@ newtype BadModuleResolutions m (effects :: [* -> *]) a = BadModuleResolutions {
 deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (BadModuleResolutions m)
 deriving instance MonadAnalysis location term value effects m => MonadAnalysis location term value effects (BadModuleResolutions m)
 
-instance ( Interpreter effects result rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          )
-      => Interpreter (Resumable (ResolutionError value) ': effects) result rest (BadModuleResolutions m) where
+      => Interpreter (Resumable (ResolutionError value) ': effects) (BadModuleResolutions m) where
+  type Result (Resumable (ResolutionError value) ': effects) (BadModuleResolutions m) result = Result effects m result
   interpret
     = interpret
     . runBadModuleResolutions

src/Analysis/Abstract/BadSyntax.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint
 module Analysis.Abstract.BadSyntax
 ( BadSyntax
@@ -21,11 +21,12 @@ newtype BadSyntax m (effects :: [* -> *]) a = BadSyntax { runBadSyntax :: m effe
 deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (BadSyntax m)
 deriving instance MonadAnalysis location term value effects m => MonadAnalysis location term value effects (BadSyntax m)
 
-instance ( Interpreter effects result rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          , AbstractHole value
          )
-      => Interpreter (Resumable (Unspecialized value) ': effects) result rest (BadSyntax m) where
+      => Interpreter (Resumable (Unspecialized value) ': effects) (BadSyntax m) where
+  type Result (Resumable (Unspecialized value) ': effects) (BadSyntax m) result = Result effects m result
   interpret
     = interpret
     . runBadSyntax

src/Analysis/Abstract/BadValues.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, KindSignatures, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Abstract.BadValues where
 
 import Control.Abstract.Analysis
@@ -12,12 +12,13 @@ newtype BadValues m (effects :: [* -> *]) a = BadValues { runBadValues :: m effe
 deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (BadValues m)
 deriving instance MonadAnalysis location term value effects m => MonadAnalysis location term value effects (BadValues m)
 
-instance ( Interpreter effects result rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          , AbstractHole value
          , Show value
          )
-      => Interpreter (Resumable (ValueError location value) ': effects) result rest (BadValues m) where
+      => Interpreter (Resumable (ValueError location value) ': effects) (BadValues m) where
+  type Result (Resumable (ValueError location value) ': effects) (BadValues m) result = Result effects m result
   interpret
     = interpret
     . runBadValues

src/Analysis/Abstract/BadVariables.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint
 module Analysis.Abstract.BadVariables
 ( BadVariables
@@ -15,11 +15,12 @@ newtype BadVariables m (effects :: [* -> *]) a = BadVariables { runBadVariables
 deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (BadVariables m)
 deriving instance MonadAnalysis location term value effects m => MonadAnalysis location term value effects (BadVariables m)
 
-instance ( Interpreter effects (result, [Name]) rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          , AbstractHole value
          )
-      => Interpreter (Resumable (EvalError value) ': State [Name] ': effects) result rest (BadVariables m) where
+      => Interpreter (Resumable (EvalError value) ': State [Name] ': effects) (BadVariables m) where
+  type Result (Resumable (EvalError value) ': State [Name] ': effects) (BadVariables m) result = Result effects m (result, [Name])
   interpret
     = interpret
     . runBadVariables

src/Analysis/Abstract/Caching.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, KindSignatures, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint
 module Analysis.Abstract.Caching
 ( Caching
@@ -121,14 +121,15 @@ scatter :: (Alternative (m effects), Foldable t, MonadEvaluator location term va
 scatter = foldMapA (\ (value, heap') -> putHeap heap' $> value)
 
 
-instance ( Interpreter effects ([result], Cache location term value) rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          , Ord (Cell location value)
          , Ord location
          , Ord term
          , Ord value
          )
-      => Interpreter (NonDet ': Reader (Cache location term value) ': State (Cache location term value) ': effects) result rest (Caching m) where
+      => Interpreter (NonDet ': Reader (Cache location term value) ': State (Cache location term value) ': effects) (Caching m) where
+  type Result (NonDet ': Reader (Cache location term value) ': State (Cache location term value) ': effects) (Caching m) result = Result effects m ([result], Cache location term value)
   interpret
     = interpret
     . runCaching

src/Analysis/Abstract/Collecting.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint
 module Analysis.Abstract.Collecting
 ( Collecting
@@ -62,11 +62,12 @@ reachable roots heap = go mempty roots
             _           -> seen)
 
 
-instance ( Interpreter effects result rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          , Ord location
          )
-      => Interpreter (Reader (Live location value) ': effects) result rest (Collecting m) where
+      => Interpreter (Reader (Live location value) ': effects) (Collecting m) where
+  type Result (Reader (Live location value) ': effects) (Collecting m) result = Result effects m result
   interpret = interpret . runCollecting . raiseHandler (`runReader` mempty)
 
 
@@ -77,9 +78,10 @@ newtype Retaining m (effects :: [* -> *]) a = Retaining { runRetaining :: m effe
 deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (Retaining m)
 deriving instance MonadAnalysis location term value effects m => MonadAnalysis location term value effects (Retaining m)
 
-instance ( Interpreter effects result rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          , Ord location
          )
-      => Interpreter (Reader (Live location value) ': effects) result rest (Retaining m) where
+      => Interpreter (Reader (Live location value) ': effects) (Retaining m) where
+  type Result (Reader (Live location value) ': effects) (Retaining m) result = Result effects m result
   interpret = interpret . runRetaining . raiseHandler (`runReader` mempty)

src/Analysis/Abstract/Dead.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint
 module Analysis.Abstract.Dead
 ( DeadCode
@@ -52,9 +52,10 @@ instance ( Corecursive term
     killAll (subterms (subterm (moduleBody m)))
     liftAnalyze analyzeModule recur m
 
-instance ( Interpreter effects (result, Dead term) rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          , Ord term
          )
-      => Interpreter (State (Dead term) ': effects) result rest (DeadCode m) where
+      => Interpreter (State (Dead term) ': effects) (DeadCode m) where
+  type Result (State (Dead term) ': effects) (DeadCode m) result = Result effects m (result, Dead term)
   interpret = interpret . runDeadCode . raiseHandler (`runState` mempty)

src/Analysis/Abstract/Erroring.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Abstract.Erroring
 ( Erroring
 ) where
@@ -13,6 +13,7 @@ newtype Erroring (exc :: * -> *) m (effects :: [* -> *]) a = Erroring { runError
 deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (Erroring exc m)
 deriving instance MonadAnalysis location term value effects m => MonadAnalysis location term value effects (Erroring exc m)
 
-instance Interpreter                   effects  (Either (SomeExc exc) result) rest               m
-      => Interpreter (Resumable exc ': effects)                       result  rest (Erroring exc m) where
+instance Interpreter                   effects                m
+      => Interpreter (Resumable exc ': effects) (Erroring exc m) where
+  type Result (Resumable exc ': effects) (Erroring exc m) result = Result effects m (Either (SomeExc exc) result)
   interpret = interpret . runErroring . raiseHandler runError

src/Analysis/Abstract/Evaluating.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
 module Analysis.Abstract.Evaluating
 ( Evaluating
 ) where
@@ -53,16 +53,14 @@ instance ( Corecursive term
   analyzeModule eval m = pushOrigin (moduleOrigin (subterm <$> m)) (eval m)
 
 
-instance Interpreter
-          (EvaluatingEffects location term value)
-          result
-          ( Either String
-          ( Either (SomeExc (LoadError term value))
-          ( Either (LoopThrow value)
-          ( Either (ReturnThrow value)
-           result)))
-          , EvaluatorState location term value)
-          (Evaluating location term value) where
+instance Interpreter (EvaluatingEffects location term value) (Evaluating location term value) where
+  type Result (EvaluatingEffects location term value) (Evaluating location term value) result
+    = ( Either String
+      ( Either (SomeExc (LoadError term value))
+      ( Either (LoopThrow value)
+      ( Either (ReturnThrow value)
+        result)))
+      , EvaluatorState location term value)
   interpret
     = interpret
     . runEvaluating

src/Analysis/Abstract/ImportGraph.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, KindSignatures, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Abstract.ImportGraph
 ( ImportGraph(..)
 , renderImportGraph
@@ -16,7 +16,7 @@ import           Data.Abstract.Located
 import           Data.Abstract.Module hiding (Module)
 import           Data.Abstract.Origin hiding (Module, Package)
 import           Data.Abstract.Package hiding (Package)
-import           Data.Aeson
+import           Data.Aeson hiding (Result)
 import qualified Data.ByteString.Char8 as BC
 import           Data.ByteString.Lazy (toStrict)
 import           Data.Output
@@ -168,6 +168,7 @@ vertexToType Module{}   = "module"
 vertexToType Variable{} = "variable"
 
 
-instance Interpreter effects (result, ImportGraph) rest m
-      => Interpreter (State ImportGraph ': effects) result rest (ImportGraphing m) where
+instance Interpreter effects m
+      => Interpreter (State ImportGraph ': effects) (ImportGraphing m) where
+  type Result (State ImportGraph ': effects) (ImportGraphing m) result = Result effects m (result, ImportGraph)
   interpret = interpret . runImportGraphing . raiseHandler (`runState` mempty)

src/Analysis/Abstract/Tracing.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, KindSignatures, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the Interpreter instance’s MonadEvaluator constraint
 module Analysis.Abstract.Tracing
 ( Tracing
@@ -36,9 +36,10 @@ instance ( Corecursive term
 
   analyzeModule = liftAnalyze analyzeModule
 
-instance ( Interpreter effects (result, trace (Configuration location term value)) rest m
+instance ( Interpreter effects m
          , MonadEvaluator location term value effects m
          , Monoid (trace (Configuration location term value))
          )
-      => Interpreter (Writer (trace (Configuration location term value)) ': effects) result rest (Tracing trace m) where
+      => Interpreter (Writer (trace (Configuration location term value)) ': effects) (Tracing trace m) where
+  type Result (Writer (trace (Configuration location term value)) ': effects) (Tracing trace m) result = Result effects m (result, trace (Configuration location term value))
   interpret = interpret . runTracing . raiseHandler runWriter

src/Analysis/Abstract/TypeChecking.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 
 module Analysis.Abstract.TypeChecking
 ( TypeChecking
@@ -14,10 +14,9 @@ newtype TypeChecking m (effects :: [* -> *]) a = TypeChecking { runTypeChecking
 deriving instance MonadEvaluator location term Type effects m => MonadEvaluator location term Type effects (TypeChecking m)
 deriving instance MonadAnalysis location term Type effects m => MonadAnalysis location term Type effects (TypeChecking m)
 
-instance ( Interpreter effects (Either (SomeExc TypeError) result) rest m
-         , MonadEvaluator location term Type effects m
-         )
-      => Interpreter (Resumable TypeError ': effects) result rest (TypeChecking m) where
+instance Interpreter effects m
+      => Interpreter (Resumable TypeError ': effects) (TypeChecking m) where
+  type Result (Resumable TypeError ': effects) (TypeChecking m) result = Result effects m (Either (SomeExc TypeError) result)
   interpret
     = interpret
     . runTypeChecking

src/Control/Abstract/Analysis.hs

@@ -51,8 +51,8 @@ liftAnalyze analyze recur term = coerce (analyze (coerceWith (sym Coercion) . r
 --
 --   This enables us to refer to the analysis type as e.g. @Analysis1 (Analysis2 Evaluating) Term Value@ without explicitly mentioning its effects (which are inferred to be simply its 'Effects').
 runAnalysis :: ( Effectful m
-               , Interpreter effects a function m
+               , Interpreter effects m
                )
             => m effects a
-            -> function
+            -> Result effects m a
 runAnalysis = interpret

src/Control/Effect.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FunctionalDependencies, RankNTypes, TypeOperators #-}
+{-# LANGUAGE FunctionalDependencies, RankNTypes, TypeFamilies, TypeOperators #-}
 module Control.Effect
 ( Effectful(..)
 , raiseHandler
@@ -46,8 +46,10 @@ raiseHandler handler = raise . handler . lower
 -- | Interpreters determine and interpret a list of effects, optionally taking extra arguments.
 --
 --   Instances will generally be defined recursively in terms of underlying interpreters, bottoming out with the instance for 'Eff' which uses 'Effect.run' to produce a final value.
-class Effectful m => Interpreter effects result function m | m -> effects, m result -> function where
-  interpret :: m effects result -> function
+class Effectful m => Interpreter effects m | m -> effects where
+  type Result effects m result
+  type instance Result effects m result = result
+  interpret :: m effects result -> Result effects m result
 
-instance Interpreter '[] result result Eff where
+instance Interpreter '[] Eff where
   interpret = Effect.run

src/Semantic/Task.hs

@@ -88,7 +88,7 @@ parse :: Member Task effs => Parser term -> Blob -> Eff effs term
 parse parser = send . Parse parser
 
 -- | A task running some 'Analysis.MonadAnalysis' to completion.
-analyze :: (Analysis.Interpreter analysisEffects result function m, Member Task effs) => m analysisEffects result -> Eff effs function
+analyze :: (Analysis.Interpreter analysisEffects m, Member Task effs) => m analysisEffects result -> Eff effs (Analysis.Result analysisEffects m result)
 analyze = send . Analyze
 
 -- | A task which decorates a 'Term' with values computed using the supplied 'RAlgebra' function.
@@ -131,7 +131,7 @@ runTaskWithOptions options task = do
 -- | An effect describing high-level tasks to be performed.
 data Task output where
   Parse    :: Parser term -> Blob -> Task term
-  Analyze  :: Analysis.Interpreter effects result function m => m effects result -> Task function
+  Analyze  :: Analysis.Interpreter effects m => m effects result -> Task (Analysis.Result effects m result)
   Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> Task (Term f (Record (field ': fields)))
   Diff     :: Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Task (Diff syntax ann1 ann2)
   Render   :: Renderer input output -> input -> Task output