catch PatternMatchFail exceptions in narrowing-based quickcheck
authorbulwahn
Mon, 19 Sep 2011 16:18:34 +0200
changeset 45003 7591039fb6b4
parent 45002 df36896aae0f
child 45004 5bd261075711
catch PatternMatchFail exceptions in narrowing-based quickcheck
src/HOL/Tools/Quickcheck/Narrowing_Engine.hs
src/HOL/Tools/Quickcheck/PNF_Narrowing_Engine.hs
--- a/src/HOL/Tools/Quickcheck/Narrowing_Engine.hs	Mon Sep 19 16:18:33 2011 +0200
+++ b/src/HOL/Tools/Quickcheck/Narrowing_Engine.hs	Mon Sep 19 16:18:34 2011 +0200
@@ -29,14 +29,19 @@
 
 -- Answers
 
-answer :: a -> (a -> IO b) -> (Pos -> IO b) -> IO b;
-answer a known unknown =
+answeri :: a -> (a -> IO b) -> (Pos -> IO b) -> IO b;
+answeri a known unknown =
   try (evaluate a) >>= (\res ->
      case res of
        Right b -> known b
        Left (ErrorCall ('\0':p)) -> unknown (map fromEnum p)
        Left e -> throw e);
 
+answer :: Bool -> (Bool -> IO b) -> (Pos -> IO b) -> IO b;
+answer a known unknown =
+  Control.Exception.catch (answeri a known unknown) 
+    (\ (PatternMatchFail _) -> known True);
+
 -- Refute
 
 str_of_list [] = "[]";
--- a/src/HOL/Tools/Quickcheck/PNF_Narrowing_Engine.hs	Mon Sep 19 16:18:33 2011 +0200
+++ b/src/HOL/Tools/Quickcheck/PNF_Narrowing_Engine.hs	Mon Sep 19 16:18:34 2011 +0200
@@ -48,14 +48,19 @@
 
 data Answer = Known Bool | Unknown Pos deriving Show;
 
-answer :: a -> (a -> IO b) -> (Pos -> IO b) -> IO b
-answer a known unknown =
+answeri :: a -> (a -> IO b) -> (Pos -> IO b) -> IO b;
+answeri a known unknown =
   do res <- try (evaluate a)
      case res of
        Right b -> known b
        Left (ErrorCall ('\0':p)) -> unknown (map fromEnum p)
        Left e -> throw e
 
+answer :: Bool -> (Bool -> IO b) -> (Pos -> IO b) -> IO b;
+answer a known unknown =
+  Control.Exception.catch (answeri a known unknown) 
+    (\ (PatternMatchFail _) -> known True)
+
 --  Proofs and Refutation
 
 data Quantifier = ExistentialQ | UniversalQ