From 5536876e138a39577b6558c444775b9808b0ebef Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 24 Apr 2018 18:39:32 -0400 Subject: [PATCH] Define an Interpreter instance for BadValues. --- src/Analysis/Abstract/BadValues.hs | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/src/Analysis/Abstract/BadValues.hs b/src/Analysis/Abstract/BadValues.hs index 7d9b4a1d3..1151d3d4f 100644 --- a/src/Analysis/Abstract/BadValues.hs +++ b/src/Analysis/Abstract/BadValues.hs @@ -2,9 +2,10 @@ module Analysis.Abstract.BadValues where import Control.Abstract.Analysis +import Control.Monad.Effect.Internal hiding (interpret) import Data.Abstract.Environment as Env -import Prologue import Data.ByteString.Char8 (pack) +import Prologue newtype BadValues m (effects :: [* -> *]) a = BadValues (m effects a) deriving (Alternative, Applicative, Functor, Effectful, Monad) @@ -39,3 +40,24 @@ instance ( Effectful m ) analyzeModule = liftAnalyze analyzeModule + +instance ( Interpreter effects result rest m + , MonadEvaluator location term value effects m + , MonadValue location value effects m + , Show value + ) + => Interpreter (Resumable (ValueError location value) ': effects) result rest (BadValues m) where + interpret = interpret . raise @m . relay pure (\ (Resumable err) yield -> case err of + ScopedEnvironmentError{} -> do + env <- lower @m getEnv + yield (Env.push env) + CallError val -> yield val + StringError val -> yield (pack (show val)) + BoolError{} -> yield True + NumericError{} -> lower @m hole >>= yield + Numeric2Error{} -> lower @m hole >>= yield + ComparisonError{} -> lower @m hole >>= yield + NamespaceError{} -> lower @m getEnv >>= yield + BitwiseError{} -> lower @m hole >>= yield + Bitwise2Error{} -> lower @m hole >>= yield + KeyValueError{} -> lower @m hole >>= \x -> yield (x, x)) . lower