Merge branch 'master' into decompose-monad-evaluator

src/Control/Abstract/Value.hs

@@ -14,7 +14,7 @@ import Prologue
 -- | 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 MonadAnalysis term value m => MonadValue term value m where
+class (MonadAnalysis term value m, Show value) => MonadValue term value m where
   -- | Construct an abstract unit value.
   unit :: m value
 
@@ -47,6 +47,8 @@ class MonadAnalysis term value m => MonadValue term value m where
 -- | Construct a 'Value' wrapping the value arguments (if any).
 instance ( MonadAddressable location (Value location term) m
          , MonadAnalysis term (Value location term) m
+         , Show location
+         , Show term
          )
          => MonadValue term (Value location term) m where
 
@@ -59,12 +61,12 @@ instance ( MonadAddressable location (Value location term) m
 
   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

src/Data/Abstract/Evaluatable.hs

@@ -88,7 +88,7 @@ load :: ( MonadAnalysis term value m
 load name = askModuleTable >>= maybe notFound evalAndCache . moduleTableLookup name
   where notFound = fail ("cannot load module: " <> show name)
         evalAndCache e = do
-          v <- evaluateTerm e
+          v <- evaluateModule e
           env <- environment v
           modifyModuleTable (moduleTableInsert name env)
           pure env

src/Data/Diff.hs

@@ -82,11 +82,6 @@ merging :: Functor syntax => Term syntax ann -> Diff syntax ann ann
 merging = cata (\ (In ann syntax) -> mergeF (In (ann, ann) syntax))
 
 
-diffPatch :: Diff syntax ann1 ann2 -> Maybe (Patch (TermF syntax ann1 (Diff syntax ann1 ann2)) (TermF syntax ann2 (Diff syntax ann1 ann2)))
-diffPatch diff = case unDiff diff of
-  Patch patch -> Just patch
-  _ -> Nothing
-
 diffPatches :: (Foldable syntax, Functor syntax) => Diff syntax ann1 ann2 -> [Patch (TermF syntax ann1 (Diff syntax ann1 ann2)) (TermF syntax ann2 (Diff syntax ann1 ann2))]
 diffPatches = para $ \ diff -> case diff of
   Patch patch -> bimap (fmap fst) (fmap fst) patch : bifoldMap (foldMap snd) (foldMap snd) patch