github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-04 13:34:31 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #1549 from github/show-constraints

Browse Source 
Add Show constraint to MonadValue to improve error messages.
This commit is contained in:
Patrick Thomson 2018-03-12 15:24:17 -04:00 committed by GitHub
commit 44cf356721
1 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Control/Abstract/Value.hs
View File

@ -17,7 +17,7 @@ import Prelude hiding (fail)
-- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc).
--
-- This allows us to abstract the choice of whether to evaluate under binders for different value types.
class (MonadEvaluator t v m) => MonadValue t v m where
class (MonadEvaluator t v m, Show v) => MonadValue t v m where
-- | Construct an abstract unit value.
unit :: m v
@ -49,6 +49,8 @@ class (MonadEvaluator t v m) => MonadValue t v m where
-- | Construct a 'Value' wrapping the value arguments (if any).
instance ( FreeVariables t
, Show t
, Show location
, MonadAddressable location (Value location t) m
, MonadAnalysis t (Value location t) m
, MonadEvaluator t (Value location t) m
@ -66,12 +68,12 @@ instance ( FreeVariables t
ifthenelse cond if' else'
| Just (Boolean b) <- prj cond = if b then if' else else'
| otherwise = fail "not defined for non-boolean conditions"
| otherwise = fail ("not defined for non-boolean condition: " <> show cond)
abstract names (Subterm body _) = inj . Closure names body <$> askLocalEnv
apply op params = do
Closure names body env <- maybe (fail "expected a closure") pure (prj op)
Closure names body env <- maybe (fail ("expected a closure, got: " <> show op)) pure (prj op)
bindings <- foldr (\ (name, param) rest -> do
v <- subtermValue param
a <- alloc name