Move Erroring into its own module.

semantic.cabal

@@ -22,6 +22,7 @@ library
                      , Analysis.Abstract.Caching
                      , Analysis.Abstract.Collecting
                      , Analysis.Abstract.Dead
+                     , Analysis.Abstract.Erroring
                      , Analysis.Abstract.Evaluating
                      , Analysis.Abstract.ImportGraph
                      , Analysis.Abstract.Quiet

src/Analysis/Abstract/Erroring.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+module Analysis.Abstract.Erroring
+( Erroring
+) where
+
+import Control.Abstract.Analysis
+import Prologue
+
+-- | An analysis that fails on errors.
+newtype Erroring (exc :: * -> *) m (effects :: [* -> *]) a = Erroring (m effects a)
+  deriving (Alternative, Applicative, Effectful, Functor, Monad)
+
+deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (Erroring exc m)
+
+instance MonadAnalysis location term value effects m
+      => MonadAnalysis location term value effects (Erroring exc m) where
+  type Effects location term value (Erroring exc m) = Resumable exc ': Effects location term value m
+
+  analyzeTerm = liftAnalyze analyzeTerm
+  analyzeModule = liftAnalyze analyzeModule
+
+instance Interpreter                   effects  (Either (SomeExc exc) result) rest               m
+      => Interpreter (Resumable exc ': effects)                       result  rest (Erroring exc m) where
+  interpret = interpret . raise @m . runError . lower

src/Semantic/Util.hs

@@ -1,5 +1,5 @@
 -- MonoLocalBinds is to silence a warning about a simplifiable constraint.
-{-# LANGUAGE GeneralizedNewtypeDeriving, MonoLocalBinds, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE MonoLocalBinds, TypeOperators #-}
 {-# OPTIONS_GHC -Wno-missing-signatures #-}
 module Semantic.Util where
 
@@ -7,7 +7,8 @@ import           Analysis.Abstract.BadAddresses
 import           Analysis.Abstract.BadModuleResolutions
 import           Analysis.Abstract.BadValues
 import           Analysis.Abstract.BadVariables
-import           Analysis.Abstract.Evaluating as X
+import           Analysis.Abstract.Erroring
+import           Analysis.Abstract.Evaluating
 import           Analysis.Abstract.ImportGraph
 import           Analysis.Abstract.Quiet
 import           Analysis.Declaration
@@ -41,23 +42,6 @@ import qualified Language.Python.Assignment as Python
 import qualified Language.Ruby.Assignment as Ruby
 import qualified Language.TypeScript.Assignment as TypeScript
 
--- | An analysis that fails on errors.
-newtype Erroring (exc :: * -> *) m (effects :: [* -> *]) a = Erroring (m effects a)
-  deriving (Alternative, Applicative, Effectful, Functor, Monad)
-
-deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (Erroring exc m)
-
-instance MonadAnalysis location term value effects m
-      => MonadAnalysis location term value effects (Erroring exc m) where
-  type Effects location term value (Erroring exc m) = Resumable exc ': Effects location term value m
-
-  analyzeTerm = liftAnalyze analyzeTerm
-  analyzeModule = liftAnalyze analyzeModule
-
-instance Interpreter                   effects  (Either (SomeExc exc) result) rest               m
-      => Interpreter (Resumable exc ': effects)                       result  rest (Erroring exc m) where
-  interpret = interpret . raise @m . runError . lower
-
 -- type TestEvaluating term = Evaluating Precise term (Value Precise)
 type JustEvaluating term
   = Erroring (AddressError (Located Precise term) (Value (Located Precise term)))