the narrowing also indicates if counterexample is potentially spurious

--- a/src/HOL/Tools/Quickcheck/Narrowing_Engine.hs	Thu Dec 01 22:14:35 2011 +0100
+++ b/src/HOL/Tools/Quickcheck/Narrowing_Engine.hs	Thu Dec 01 22:14:35 2011 +0100
@@ -29,32 +29,33 @@
 
 -- Answers
 
-answeri :: a -> (a -> IO b) -> (Pos -> IO b) -> IO b;
+answeri :: a -> (Bool -> a -> IO b) -> (Pos -> IO b) -> IO b;
 answeri a known unknown =
   try (evaluate a) >>= (\res ->
      case res of
-       Right b -> known b
+       Right b -> known True b
        Left (ErrorCall ('\0':p)) -> unknown (map fromEnum p)
        Left e -> throw e);
 
-answer :: Bool -> Bool -> (Bool -> IO b) -> (Pos -> IO b) -> IO b;
+answer :: Bool -> Bool -> (Bool -> Bool -> IO b) -> (Pos -> IO b) -> IO b;
 answer potential a known unknown =
   Control.Exception.catch (answeri a known unknown) 
-    (\ (PatternMatchFail _) -> known (not potential));
+    (\ (PatternMatchFail _) -> known False (not potential));
 
 -- Refute
 
 str_of_list [] = "[]";
 str_of_list (x:xs) = "(" ++ x ++ " :: " ++ str_of_list xs ++ ")";
 
-report :: Result -> [Generated_Code.Narrowing_term] -> IO Int;
-report r xs = putStrLn ("SOME (" ++ (str_of_list $ zipWith ($) (showArgs r) xs) ++ ")") >> hFlush stdout >> exitWith ExitSuccess;
+report :: Bool -> Result -> [Generated_Code.Narrowing_term] -> IO Int;
+report genuine r xs = putStrLn ("SOME (" ++ (if genuine then "true" else "false") ++
+  ", " ++ (str_of_list $ zipWith ($) (showArgs r) xs) ++ ")") >> hFlush stdout >> exitWith ExitSuccess;
 
-eval :: Bool -> Bool -> (Bool -> IO a) -> (Pos -> IO a) -> IO a;
-eval potential p k u = answer potential p (\p -> answer potential p k u) u;
+eval :: Bool -> Bool -> (Bool -> Bool -> IO a) -> (Pos -> IO a) -> IO a;
+eval potential p k u = answer potential p (\genuine p -> answer potential p k u) u;
 
 ref :: Bool -> Result -> [Generated_Code.Narrowing_term] -> IO Int;
-ref potential r xs = eval potential (apply_fun r xs) (\res -> if res then return 1 else report r xs)
+ref potential r xs = eval potential (apply_fun r xs) (\genuine res -> if res then return 1 else report genuine r xs)
   (\p -> sumMapM (ref potential r) 1 (refineList xs p));
           
 refute :: Bool -> Result -> IO Int;
@@ -115,4 +116,3 @@
 smallCheck potential d p = mapM_ (\d -> depthCheck potential d p) [0..d] >> putStrLn ("NONE") >> hFlush stdout;
 
 }
-

--- a/src/HOL/Tools/Quickcheck/narrowing_generators.ML	Thu Dec 01 22:14:35 2011 +0100
+++ b/src/HOL/Tools/Quickcheck/narrowing_generators.ML	Thu Dec 01 22:14:35 2011 +0100
@@ -14,7 +14,7 @@
   datatype counterexample = Universal_Counterexample of (term * counterexample)
     | Existential_Counterexample of (term * counterexample) list
     | Empty_Assignment
-  val put_counterexample: (unit -> term list option) -> Proof.context -> Proof.context
+  val put_counterexample: (unit -> (bool * term list) option) -> Proof.context -> Proof.context
   val put_existential_counterexample : (unit -> counterexample option) -> Proof.context -> Proof.context
   val setup: theory -> theory
 end;
@@ -302,7 +302,7 @@
   
 structure Counterexample = Proof_Data
 (
-  type T = unit -> term list option
+  type T = unit -> (bool * term list) option
   fun init _ () = error "Counterexample"
 )
 
@@ -450,11 +450,11 @@
           Const (@{const_name Quickcheck_Narrowing.ensure_testable}, fastype_of t --> fastype_of t) $ t
         val (counterexample, result) = dynamic_value_strict (false, opts)
           (Counterexample.get, Counterexample.put, "Narrowing_Generators.put_counterexample")
-          thy (apfst o Option.map o map) (ensure_testable (finitize t'))
+          thy (apfst o Option.map o apsnd o map) (ensure_testable (finitize t'))
       in
         Quickcheck.Result
          {counterexample =
-           Option.map (((curry (op ~~)) (Term.add_free_names t [])) o map post_process) counterexample,
+           Option.map (((curry (op ~~)) (Term.add_free_names t [])) o map post_process o snd) counterexample,
           evaluation_terms = Option.map (K []) counterexample,
           timings = #timings (dest_result result), reports = #reports (dest_result result)}
       end