diff --git a/semantic.cabal b/semantic.cabal index 6d5253184..a6be14ea7 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -16,6 +16,7 @@ library exposed-modules: -- Analyses & term annotations Analysis.Abstract.BadVariables + Analysis.Abstract.BadValues , Analysis.Abstract.Caching , Analysis.Abstract.Collecting , Analysis.Abstract.Dead diff --git a/src/Analysis/Abstract/BadValues.hs b/src/Analysis/Abstract/BadValues.hs new file mode 100644 index 000000000..9d1022472 --- /dev/null +++ b/src/Analysis/Abstract/BadValues.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators #-} +module Analysis.Abstract.BadValues where + +import Control.Abstract.Analysis +import Data.Abstract.Evaluatable +import Analysis.Abstract.Evaluating +import Data.Abstract.Environment as Env +import Prologue + +newtype BadValues m term value (effects :: [* -> *]) a = BadValues (m term value effects a) + deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet) + +deriving instance MonadControl term (m term value effects) => MonadControl term (BadValues m term value effects) +deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (BadValues m term value effects) +deriving instance MonadHeap value (m term value effects) => MonadHeap value (BadValues m term value effects) +deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (BadValues m term value effects) +deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (BadValues m term value effects) + +instance ( Effectful (m term value) + , Member (Resumable (ValueExc value)) effects + , Member (State (EvaluatingState term value)) effects + , Member (State [Name]) effects + , MonadAnalysis term value (m term value effects) + , MonadValue value (BadValues m term value effects) + ) + => MonadAnalysis term value (BadValues m term value effects) where + type RequiredEffects term value (BadValues m term value effects) = State [Name] ': RequiredEffects term value (m term value effects) + + analyzeTerm eval term = resumeException @(ValueExc value) (liftAnalyze analyzeTerm eval term) ( + \yield (ScopedEnvironmentError _) -> + do + env <- getEnv + yield (Env.push env)) + + analyzeModule = liftAnalyze analyzeModule