github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Move Erroring into its own module.

Browse Source
This commit is contained in:
Rob Rix 2018-04-24 18:44:23 -04:00
parent b032d91900
commit 1cedeac8e1
3 changed files with 28 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
semantic.cabal
View File

@ -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

24
src/Analysis/Abstract/Erroring.hs Normal file
View File

@ -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

22
src/Semantic/Util.hs
View File

@ -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)))