github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00
Code Issues Projects Releases Wiki Activity

Define an Interpreter instance for BadValues.

Browse Source
This commit is contained in:
Rob Rix 2018-04-24 18:39:32 -04:00
parent ef4ed428cf
commit 5536876e13
1 changed files with 23 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/Analysis/Abstract/BadValues.hs
View File

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