From d4769e41ba928a9ad8a2b868fb94786c56ecda8c Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 17 Apr 2018 11:43:02 -0700 Subject: [PATCH] Throw instead of failing for bad pair value --- src/Analysis/Abstract/BadValues.hs | 1 + src/Control/Abstract/Value.hs | 1 + src/Data/Abstract/Value.hs | 6 +++--- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Analysis/Abstract/BadValues.hs b/src/Analysis/Abstract/BadValues.hs index 4300f97a5..0ecf25266 100644 --- a/src/Analysis/Abstract/BadValues.hs +++ b/src/Analysis/Abstract/BadValues.hs @@ -37,6 +37,7 @@ instance ( Effectful m BoolError{} -> yield True Numeric2Error{} -> unit >>= yield NamespaceError{} -> getEnv >>= yield + KeyValueError{} -> unit >>= \x -> yield (x, x) ) analyzeModule = liftAnalyze analyzeModule diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index d2b3e7c33..b674b613c 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -195,6 +195,7 @@ data ValueError location value resume where CallError :: value -> ValueError location value value BoolError :: value -> ValueError location value Bool Numeric2Error :: value -> value -> ValueError location value value + KeyValueError :: value -> ValueError location value (value, value) instance Eq value => Eq1 (ValueError location value) where liftEq _ (StringError a) (StringError b) = a == b diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 0aa986b64..e6a9b9092 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -206,9 +206,9 @@ instance forall location term m. (Monad m, MonadEvaluatable location term (Value null = pure . injValue $ Null - asPair k - | Just (KVPair k v) <- prjValue k = pure (k, v) - | otherwise = fail ("expected key-value pair, got " <> show k) + asPair val + | Just (KVPair k v) <- prjValue val = pure (k, v) + | otherwise = throwException @(ValueError location (Value location)) $ KeyValueError val hash = pure . injValue . Hash . fmap (injValue . uncurry KVPair)