moving some common functions from quickcheck to the more HOL-specific quickcheck_common; renamed inductive_SML's configurations to more canonical names; adds automatically left and right hand sides of equations as evaluation terms
authorbulwahn
Mon, 17 Oct 2011 10:19:01 +0200
changeset 45159 3f1d1ce024cb
parent 45157 efc2e2d80218
child 45160 b09575e075a5
moving some common functions from quickcheck to the more HOL-specific quickcheck_common; renamed inductive_SML's configurations to more canonical names; adds automatically left and right hand sides of equations as evaluation terms
src/HOL/Mutabelle/mutabelle.ML
src/HOL/Mutabelle/mutabelle_extra.ML
src/HOL/Quickcheck.thy
src/HOL/Tools/Quickcheck/exhaustive_generators.ML
src/HOL/Tools/Quickcheck/narrowing_generators.ML
src/HOL/Tools/Quickcheck/quickcheck_common.ML
src/HOL/Tools/Quickcheck/random_generators.ML
src/HOL/Tools/inductive_codegen.ML
src/Tools/quickcheck.ML
--- a/src/HOL/Mutabelle/mutabelle.ML	Sun Oct 16 21:49:47 2011 +0200
+++ b/src/HOL/Mutabelle/mutabelle.ML	Mon Oct 17 10:19:01 2011 +0200
@@ -496,7 +496,7 @@
     val ctxt' = Proof_Context.init_global thy
       |> Config.put Quickcheck.size 1
       |> Config.put Quickcheck.iterations 1
-    val test = Quickcheck.test_term Exhaustive_Generators.compile_generator_expr ctxt' (true, false)
+    val test = Quickcheck_Common.test_term Exhaustive_Generators.compile_generator_expr ctxt' (true, false)
   in  
     case try test (preprocess thy insts (prop_of th), []) of
       SOME _ => (Output.urgent_message "executable"; true)
--- a/src/HOL/Mutabelle/mutabelle_extra.ML	Sun Oct 16 21:49:47 2011 +0200
+++ b/src/HOL/Mutabelle/mutabelle_extra.ML	Mon Oct 17 10:19:01 2011 +0200
@@ -122,8 +122,11 @@
   TimeLimit.timeLimit (seconds (!Try.auto_time_limit))
       (fn _ =>
           let
-            val SOME [result] = Quickcheck.test_goal_terms (change_options (Proof_Context.init_global thy))
-              (false, false) [] [(t, [])]
+            val ctxt' = change_options (Proof_Context.init_global thy)
+            val [result] = case Quickcheck.active_testers ctxt' of
+              [] => error "No active testers for quickcheck"
+            | [tester] => tester ctxt' (false, false) [] [(t, [])]
+            | _ => error "Multiple active testers for quickcheck"
           in
             case Quickcheck.counterexample_of result of 
               NONE => (NoCex, Quickcheck.timings_of result)
@@ -317,11 +320,12 @@
     val ctxt = Proof_Context.init_global thy
   in
     can (TimeLimit.timeLimit (seconds 2.0)
-      (Quickcheck.test_goal_terms
+      (Quickcheck.test_terms
         ((Config.put Quickcheck.finite_types true #>
           Config.put Quickcheck.finite_type_size 1 #>
           Config.put Quickcheck.size 1 #> Config.put Quickcheck.iterations 1) ctxt)
-        (false, false) [])) (map (rpair [] o Object_Logic.atomize_term thy) (fst (Variable.import_terms true [t] ctxt)))
+        (false, false) [])) (map (rpair [] o Object_Logic.atomize_term thy)
+        (fst (Variable.import_terms true [t] ctxt)))
   end
 
 fun is_executable_thm thy th = is_executable_term thy (prop_of th)
--- a/src/HOL/Quickcheck.thy	Sun Oct 16 21:49:47 2011 +0200
+++ b/src/HOL/Quickcheck.thy	Mon Oct 17 10:19:01 2011 +0200
@@ -144,6 +144,12 @@
 no_notation fcomp (infixl "\<circ>>" 60)
 no_notation scomp (infixl "\<circ>\<rightarrow>" 60)
 
+subsection {* Tester SML-inductive based on the SML code generator *}
+
+setup {*
+  Context.theory_map (Quickcheck.add_tester ("SML_inductive",
+    (Inductive_Codegen.active, Quickcheck_Common.generator_test_goal_terms Inductive_Codegen.test_term)));
+*}
 
 subsection {* The Random-Predicate Monad *} 
 
--- a/src/HOL/Tools/Quickcheck/exhaustive_generators.ML	Sun Oct 16 21:49:47 2011 +0200
+++ b/src/HOL/Tools/Quickcheck/exhaustive_generators.ML	Mon Oct 17 10:19:01 2011 +0200
@@ -488,7 +488,7 @@
       thy (SOME target) (K I) (HOLogic.mk_list @{typ "code_numeral => bool"} ts') []
   end;
 
-val test_goals = Quickcheck.generator_test_goal_terms compile_generator_expr;
+val test_goals = Quickcheck_Common.generator_test_goal_terms compile_generator_expr;
   
 (* setup *)
 
--- a/src/HOL/Tools/Quickcheck/narrowing_generators.ML	Sun Oct 16 21:49:47 2011 +0200
+++ b/src/HOL/Tools/Quickcheck/narrowing_generators.ML	Mon Oct 17 10:19:01 2011 +0200
@@ -462,9 +462,9 @@
 fun test_goals ctxt (limit_time, is_interactive) insts goals =
   if (not (getenv "ISABELLE_GHC" = "")) then
     let
-      val correct_inst_goals = Quickcheck.instantiate_goals ctxt insts goals
+      val correct_inst_goals = Quickcheck_Common.instantiate_goals ctxt insts goals
     in
-      Quickcheck.collect_results (test_term ctxt (limit_time, is_interactive)) (maps (map snd) correct_inst_goals) []
+      Quickcheck_Common.collect_results (test_term ctxt (limit_time, is_interactive)) (maps (map snd) correct_inst_goals) []
     end
   else
     (if Config.get ctxt Quickcheck.quiet then () else Output.urgent_message
--- a/src/HOL/Tools/Quickcheck/quickcheck_common.ML	Sun Oct 16 21:49:47 2011 +0200
+++ b/src/HOL/Tools/Quickcheck/quickcheck_common.ML	Mon Oct 17 10:19:01 2011 +0200
@@ -11,6 +11,13 @@
     -> string -> string list -> string list -> typ list -> Proof.context -> Proof.context 
   val perhaps_constrain: theory -> (typ * sort) list -> (string * sort) list
     -> (string * sort -> string * sort) option
+  val instantiate_goals: Proof.context -> (string * typ) list -> (term * term list) list
+    -> (typ option * (term * term list)) list list
+  val collect_results : ('a -> Quickcheck.result) -> 'a list -> Quickcheck.result list -> Quickcheck.result list
+  type compile_generator =
+    Proof.context -> (term * term list) list -> int list -> term list option * Quickcheck.report option
+  val generator_test_goal_terms : compile_generator -> Proof.context -> bool * bool
+    -> (string * typ) list -> (term * term list) list -> Quickcheck.result list
   val ensure_sort_datatype:
     ((sort * sort) * sort) * (Datatype.config -> Datatype.descr -> (string * sort) list
       -> string list -> string -> string list * string list -> typ list * typ list -> theory -> theory)
@@ -20,6 +27,7 @@
      -> Proof.context -> (term * term list) list -> term
   val mk_fun_upd : typ -> typ -> term * term -> term -> term
   val post_process_term : term -> term
+  val test_term : compile_generator -> Proof.context -> bool * bool -> term * term list -> Quickcheck.result
 end;
 
 structure Quickcheck_Common : QUICKCHECK_COMMON =
@@ -35,7 +43,222 @@
   | strip_imp A = ([], A)
 
 fun mk_undefined T = Const(@{const_name undefined}, T)
+
+(* testing functions: testing with increasing sizes (and cardinalities) *)
+
+type compile_generator =
+  Proof.context -> (term * term list) list -> int list -> term list option * Quickcheck.report option
+
+fun check_test_term t =
+  let
+    val _ = (null (Term.add_tvars t []) andalso null (Term.add_tfrees t [])) orelse
+      error "Term to be tested contains type variables";
+    val _ = null (Term.add_vars t []) orelse
+      error "Term to be tested contains schematic variables";
+  in () end
+
+fun cpu_time description e =
+  let val ({cpu, ...}, result) = Timing.timing e ()
+  in (result, (description, Time.toMilliseconds cpu)) end
+
+fun test_term compile ctxt (limit_time, is_interactive) (t, eval_terms) =
+  let
+    val _ = check_test_term t
+    val names = Term.add_free_names t []
+    val current_size = Unsynchronized.ref 0
+    val current_result = Unsynchronized.ref Quickcheck.empty_result 
+    fun excipit () =
+      "Quickcheck ran out of time while testing at size " ^ string_of_int (!current_size)
+    fun with_size test_fun k =
+      if k > Config.get ctxt Quickcheck.size then
+        NONE
+      else
+        let
+          val _ = Quickcheck.message ctxt ("Test data size: " ^ string_of_int k)
+          val _ = current_size := k
+          val ((result, report), timing) =
+            cpu_time ("size " ^ string_of_int k) (fn () => test_fun [1, k - 1])
+          val _ = Quickcheck.add_timing timing current_result
+          val _ = Quickcheck.add_report k report current_result
+        in
+          case result of NONE => with_size test_fun (k + 1) | SOME q => SOME q
+        end;
+  in
+    (*limit (seconds (Config.get ctxt timeout)) (limit_time, is_interactive) (fn () =>*)(
+      let
+        val (test_fun, comp_time) = cpu_time "quickcheck compilation"
+          (fn () => compile ctxt [(t, eval_terms)]);
+        val _ = Quickcheck.add_timing comp_time current_result
+        val (response, exec_time) =
+          cpu_time "quickcheck execution" (fn () => with_size test_fun 1)
+        val _ = Quickcheck.add_response names eval_terms response current_result
+        val _ = Quickcheck.add_timing exec_time current_result
+      in !current_result end)
+(*    (fn () => (message (excipit ()); !current_result)) ()*)
+  end;
+
+fun validate_terms ctxt ts =
+  let
+    val _ = map check_test_term ts
+    val size = Config.get ctxt Quickcheck.size
+    val (test_funs, comp_time) = cpu_time "quickcheck batch compilation"
+      (fn () => Quickcheck.mk_batch_validator ctxt ts) 
+    fun with_size tester k =
+      if k > size then true
+      else if tester k then with_size tester (k + 1) else false
+    val (results, exec_time) = cpu_time "quickcheck batch execution" (fn () =>
+        Option.map (map (fn test_fun => TimeLimit.timeLimit (seconds (Config.get ctxt Quickcheck.timeout))
+              (fn () => with_size test_fun 1) ()
+             handle TimeLimit.TimeOut => true)) test_funs)
+  in
+    (results, [comp_time, exec_time])
+  end
   
+fun test_terms ctxt ts =
+  let
+    val _ = map check_test_term ts
+    val size = Config.get ctxt Quickcheck.size
+    val namess = map (fn t => Term.add_free_names t []) ts
+    val (test_funs, comp_time) =
+      cpu_time "quickcheck batch compilation" (fn () => Quickcheck.mk_batch_tester ctxt ts) 
+    fun with_size tester k =
+      if k > size then NONE
+      else case tester k of SOME ts => SOME ts | NONE => with_size tester (k + 1)
+    val (results, exec_time) = cpu_time "quickcheck batch execution" (fn () =>
+        Option.map (map (fn test_fun => TimeLimit.timeLimit (seconds (Config.get ctxt Quickcheck.timeout))
+              (fn () => with_size test_fun 1) ()
+             handle TimeLimit.TimeOut => NONE)) test_funs)
+  in
+    (Option.map (map2 (fn names => Option.map (fn ts => names ~~ ts)) namess) results,
+      [comp_time, exec_time])
+  end
+
+
+fun test_term_with_increasing_cardinality compile ctxt (limit_time, is_interactive) ts =
+  let
+    val thy = Proof_Context.theory_of ctxt
+    val (ts', eval_terms) = split_list ts
+    val _ = map check_test_term ts'
+    val names = Term.add_free_names (hd ts') []
+    val Ts = map snd (Term.add_frees (hd ts') [])
+    val current_result = Unsynchronized.ref Quickcheck.empty_result
+    fun test_card_size test_fun (card, size) =
+      (* FIXME: why decrement size by one? *)
+      let
+        val (ts, timing) =
+          cpu_time ("size " ^ string_of_int size ^ " and card " ^ string_of_int card)
+            (fn () => fst (test_fun [card, size - 1]))
+        val _ = Quickcheck.add_timing timing current_result
+      in
+        Option.map (pair card) ts
+      end
+    val enumeration_card_size =
+      if forall (fn T => Sign.of_sort thy (T,  ["Enum.enum"])) Ts then
+        (* size does not matter *)
+        map (rpair 0) (1 upto (length ts))
+      else
+        (* size does matter *)
+        map_product pair (1 upto (length ts)) (1 upto (Config.get ctxt Quickcheck.size))
+        |> sort (fn ((c1, s1), (c2, s2)) => int_ord ((c1 + s1), (c2 + s2)))
+  in
+    (*limit (seconds (Config.get ctxt timeout)) (limit_time, is_interactive) (fn () =>*)(
+      let
+        val (test_fun, comp_time) = cpu_time "quickcheck compilation" (fn () => compile ctxt ts)
+        val _ = Quickcheck.add_timing comp_time current_result     
+        val _ = case get_first (test_card_size test_fun) enumeration_card_size of
+          SOME (card, ts) => Quickcheck.add_response names (nth eval_terms (card - 1)) (SOME ts) current_result
+        | NONE => ()
+      in !current_result end)
+      (*(fn () => (message "Quickcheck ran out of time"; !current_result)) ()*)
+  end
+
+fun get_finite_types ctxt =
+  fst (chop (Config.get ctxt Quickcheck.finite_type_size)
+    (map (Type o rpair []) ["Enum.finite_1", "Enum.finite_2", "Enum.finite_3",
+     "Enum.finite_4", "Enum.finite_5"]))
+
+exception WELLSORTED of string
+
+fun monomorphic_term thy insts default_T =
+  let
+    fun subst (T as TFree (v, S)) =
+      let
+        val T' = AList.lookup (op =) insts v
+          |> the_default default_T
+      in if Sign.of_sort thy (T', S) then T'
+        else raise (WELLSORTED ("For instantiation with default_type " ^
+          Syntax.string_of_typ_global thy default_T ^
+          ":\n" ^ Syntax.string_of_typ_global thy T' ^
+          " to be substituted for variable " ^
+          Syntax.string_of_typ_global thy T ^ " does not have sort " ^
+          Syntax.string_of_sort_global thy S))
+      end
+      | subst T = T;
+  in (map_types o map_atyps) subst end;
+
+datatype wellsorted_error = Wellsorted_Error of string | Term of term * term list
+
+fun instantiate_goals lthy insts goals =
+  let
+    fun map_goal_and_eval_terms f (check_goal, eval_terms) = (f check_goal, map f eval_terms)
+    val thy = Proof_Context.theory_of lthy
+    val default_insts =
+      if Config.get lthy Quickcheck.finite_types then (get_finite_types lthy) else (Quickcheck.default_type lthy)
+    val inst_goals =
+      map (fn (check_goal, eval_terms) =>
+        if not (null (Term.add_tfree_names check_goal [])) then
+          map (fn T =>
+            (pair (SOME T) o Term o apfst (Object_Logic.atomize_term thy))
+              (map_goal_and_eval_terms (monomorphic_term thy insts T) (check_goal, eval_terms))
+              handle WELLSORTED s => (SOME T, Wellsorted_Error s)) default_insts
+        else
+          [(NONE, Term (Object_Logic.atomize_term thy check_goal, eval_terms))]) goals
+    val error_msg =
+      cat_lines
+        (maps (map_filter (fn (_, Term t) => NONE | (_, Wellsorted_Error s) => SOME s)) inst_goals)
+    fun is_wellsorted_term (T, Term t) = SOME (T, t)
+      | is_wellsorted_term (_, Wellsorted_Error s) = NONE
+    val correct_inst_goals =
+      case map (map_filter is_wellsorted_term) inst_goals of
+        [[]] => error error_msg
+      | xs => xs
+    val _ = if Config.get lthy Quickcheck.quiet then () else warning error_msg
+  in
+    correct_inst_goals
+  end
+
+fun collect_results f [] results = results
+  | collect_results f (t :: ts) results =
+    let
+      val result = f t
+    in
+      if Quickcheck.found_counterexample result then
+        (result :: results)
+      else
+        collect_results f ts (result :: results)
+    end  
+
+fun add_equation_eval_terms (t, eval_terms) =
+  case try HOLogic.dest_eq (snd (strip_imp t)) of
+    SOME (lhs, rhs) => (t, eval_terms @ [rhs, lhs])
+  | NONE => (t, eval_terms)
+
+fun generator_test_goal_terms compile ctxt (limit_time, is_interactive) insts goals =
+  let
+    fun test_term' goal =
+      case goal of
+        [(NONE, t)] => test_term compile ctxt (limit_time, is_interactive) t
+      | ts => test_term_with_increasing_cardinality compile ctxt (limit_time, is_interactive) (map snd ts)
+    val goals' = instantiate_goals ctxt insts goals
+      |> map (map (apsnd add_equation_eval_terms))
+  in
+    if Config.get ctxt Quickcheck.finite_types then
+      collect_results test_term' goals' []
+    else
+      collect_results (test_term compile ctxt (limit_time, is_interactive))
+        (maps (map snd) goals') []
+  end;
+
 (* defining functions *)
 
 fun pat_completeness_auto ctxt =
--- a/src/HOL/Tools/Quickcheck/random_generators.ML	Sun Oct 16 21:49:47 2011 +0200
+++ b/src/HOL/Tools/Quickcheck/random_generators.ML	Mon Oct 17 10:19:01 2011 +0200
@@ -438,7 +438,7 @@
       end
   end;
 
-val test_goals = Quickcheck.generator_test_goal_terms compile_generator_expr;
+val test_goals = Quickcheck_Common.generator_test_goal_terms compile_generator_expr;
   
 (** setup **)
 
--- a/src/HOL/Tools/inductive_codegen.ML	Sun Oct 16 21:49:47 2011 +0200
+++ b/src/HOL/Tools/inductive_codegen.ML	Mon Oct 17 10:19:01 2011 +0200
@@ -10,8 +10,8 @@
   val poke_test_fn: (int * int * int -> term list option) -> unit
   val test_term: Proof.context -> (term * term list) list -> int list ->
     term list option * Quickcheck.report option
+  val active : bool Config.T
   val setup: theory -> theory
-  val quickcheck_setup: theory -> theory
 end;
 
 structure Inductive_Codegen : INDUCTIVE_CODEGEN =
@@ -862,12 +862,12 @@
       NONE => deepen bound f (i + 1)
     | SOME x => SOME x);
 
-val active = Attrib.setup_config_bool @{binding quickcheck_inductive_SML_active} (K false);
+val active = Attrib.setup_config_bool @{binding quickcheck_SML_inductive_active} (K false);
     
-val depth_bound = Attrib.setup_config_int @{binding ind_quickcheck_depth} (K 10);
-val depth_start = Attrib.setup_config_int @{binding ind_quickcheck_depth_start} (K 1);
-val random_values = Attrib.setup_config_int @{binding ind_quickcheck_random} (K 5);
-val size_offset = Attrib.setup_config_int @{binding ind_quickcheck_size_offset} (K 0);
+val depth_bound = Attrib.setup_config_int @{binding quickcheck_ind_depth} (K 10);
+val depth_start = Attrib.setup_config_int @{binding quickcheck_ind_depth_start} (K 1);
+val random_values = Attrib.setup_config_int @{binding quickcheck_ind_random} (K 5);
+val size_offset = Attrib.setup_config_int @{binding quickcheck_ind_size_offset} (K 0);
 
 fun test_term ctxt [(t, [])] =
       let
@@ -926,9 +926,4 @@
   | test_term ctxt _ =
       error "Compilation of multiple instances is not supported by tester SML_inductive";
 
-val test_goal = Quickcheck.generator_test_goal_terms test_term;
-
-val quickcheck_setup =
-  Context.theory_map (Quickcheck.add_tester ("SML_inductive", (active, test_goal)));
-
 end;
--- a/src/Tools/quickcheck.ML	Sun Oct 16 21:49:47 2011 +0200
+++ b/src/Tools/quickcheck.ML	Mon Oct 17 10:19:01 2011 +0200
@@ -29,6 +29,7 @@
   val test_params_of : Proof.context -> test_params
   val map_test_params : (typ list * expectation -> typ list * expectation)
     -> Context.generic -> Context.generic
+  val default_type : Proof.context -> typ list
   datatype report = Report of
     { iterations : int, raised_match_errors : int,
       satisfied_assms : int list, positive_concl_tests : int }
@@ -40,7 +41,10 @@
       timings : (string * int) list,
       reports : (int * report) list}
   val empty_result : result
+  val found_counterexample : result -> bool
   val add_timing : (string * int) -> result Unsynchronized.ref -> unit
+  val add_response : string list -> term list -> term list option -> result Unsynchronized.ref -> unit
+  val add_report : int -> report option -> result Unsynchronized.ref -> unit
   val counterexample_of : result -> (string * term) list option
   val timings_of : result -> (string * int) list
   (* registering testers & generators *) 
@@ -54,23 +58,15 @@
     string * (Proof.context -> term list -> (int -> bool) list)
       -> Context.generic -> Context.generic
   (* basic operations *)
-  type compile_generator =
-    Proof.context -> (term * term list) list -> int list -> term list option * report option
-  val limit : Time.time -> (bool * bool) -> (unit -> 'a) -> (unit -> 'a) -> unit -> 'a  
-  val instantiate_goals: Proof.context -> (string * typ) list -> (term * term list) list
-    -> (typ option * (term * term list)) list list
-  val collect_results : ('a -> result) -> 'a list -> result list -> result list
-  val generator_test_goal_terms : compile_generator ->
-    Proof.context -> bool * bool -> (string * typ) list -> (term * term list) list -> result list
+  val message : Proof.context -> string -> unit
+  val limit : Time.time -> (bool * bool) -> (unit -> 'a) -> (unit -> 'a) -> unit -> 'a
   (* testing terms and proof states *)
-  val test_term: compile_generator -> Proof.context -> bool * bool -> term * term list -> result
-  val test_goal_terms :
+  val mk_batch_validator : Proof.context -> term list -> (int -> bool) list option
+  val mk_batch_tester : Proof.context -> term list -> (int -> term list option) list option
+  val active_testers : Proof.context -> tester list
+  val test_terms :
     Proof.context -> bool * bool -> (string * typ) list -> (term * term list) list -> result list option
   val quickcheck: (string * string list) list -> int -> Proof.state -> (string * term) list option
-  (* testing a batch of terms *)
-  val test_terms:
-    Proof.context -> term list -> (string * term) list option list option * (string * int) list
-  val validate_terms: Proof.context -> term list -> bool list option * (string * int) list
 end;
 
 structure Quickcheck : QUICKCHECK =
@@ -119,14 +115,15 @@
 
 fun timings_of (Result r) = #timings r
 
-fun set_reponse names eval_terms (SOME ts) (Result r) =
+fun set_response names eval_terms (SOME ts) (Result r) =
   let
     val (ts1, ts2) = chop (length names) ts
+    val (eval_terms', _) = chop (length ts2) eval_terms
   in
-    Result {counterexample = SOME (names ~~ ts1), evaluation_terms = SOME (eval_terms ~~ ts2),
+    Result {counterexample = SOME (names ~~ ts1), evaluation_terms = SOME (eval_terms' ~~ ts2),
       timings = #timings r, reports = #reports r}
   end
-  | set_reponse _ _ NONE result = result
+  | set_response _ _ NONE result = result
 
 
 fun set_counterexample counterexample (Result r) =
@@ -153,7 +150,7 @@
   Unsynchronized.change result_ref (cons_report size report)
 
 fun add_response names eval_terms response result_ref =
-  Unsynchronized.change result_ref (set_reponse names eval_terms response)
+  Unsynchronized.change result_ref (set_response names eval_terms response)
 
 (* expectation *)
 
@@ -275,18 +272,6 @@
 type compile_generator =
   Proof.context -> (term * term list) list -> int list -> term list option * report option
 
-fun check_test_term t =
-  let
-    val _ = (null (Term.add_tvars t []) andalso null (Term.add_tfrees t [])) orelse
-      error "Term to be tested contains type variables";
-    val _ = null (Term.add_vars t []) orelse
-      error "Term to be tested contains schematic variables";
-  in () end
-
-fun cpu_time description e =
-  let val ({cpu, ...}, result) = Timing.timing e ()
-  in (result, (description, Time.toMilliseconds cpu)) end
-
 fun limit timeout (limit_time, is_interactive) f exc () =
   if limit_time then
       TimeLimit.timeLimit timeout f ()
@@ -295,205 +280,9 @@
   else
     f ()
 
-fun test_term compile ctxt (limit_time, is_interactive) (t, eval_terms) =
-  let
-    fun message s = if Config.get ctxt quiet then () else Output.urgent_message s
-    val _ = check_test_term t
-    val names = Term.add_free_names t []
-    val current_size = Unsynchronized.ref 0
-    val current_result = Unsynchronized.ref empty_result 
-    fun excipit () =
-      "Quickcheck ran out of time while testing at size " ^ string_of_int (!current_size)
-    fun with_size test_fun k =
-      if k > Config.get ctxt size then
-        NONE
-      else
-        let
-          val _ = message ("Test data size: " ^ string_of_int k)
-          val _ = current_size := k
-          val ((result, report), timing) =
-            cpu_time ("size " ^ string_of_int k) (fn () => test_fun [1, k - 1])
-          val _ = add_timing timing current_result
-          val _ = add_report k report current_result
-        in
-          case result of NONE => with_size test_fun (k + 1) | SOME q => SOME q
-        end;
-  in
-    (*limit (seconds (Config.get ctxt timeout)) (limit_time, is_interactive) (fn () =>*)(
-      let
-        val (test_fun, comp_time) = cpu_time "quickcheck compilation"
-          (fn () => compile ctxt [(t, eval_terms)]);
-        val _ = add_timing comp_time current_result
-        val (response, exec_time) =
-          cpu_time "quickcheck execution" (fn () => with_size test_fun 1)
-        val _ = add_response names eval_terms response current_result
-        val _ = add_timing exec_time current_result
-      in !current_result end)
-(*    (fn () => (message (excipit ()); !current_result)) ()*)
-  end;
-
-fun validate_terms ctxt ts =
-  let
-    val _ = map check_test_term ts
-    val size = Config.get ctxt size
-    val (test_funs, comp_time) = cpu_time "quickcheck batch compilation"
-      (fn () => mk_batch_validator ctxt ts) 
-    fun with_size tester k =
-      if k > size then true
-      else if tester k then with_size tester (k + 1) else false
-    val (results, exec_time) = cpu_time "quickcheck batch execution" (fn () =>
-        Option.map (map (fn test_fun => TimeLimit.timeLimit (seconds (Config.get ctxt timeout))
-              (fn () => with_size test_fun 1) ()
-             handle TimeLimit.TimeOut => true)) test_funs)
-  in
-    (results, [comp_time, exec_time])
-  end
-  
-fun test_terms ctxt ts =
-  let
-    val _ = map check_test_term ts
-    val size = Config.get ctxt size
-    val namess = map (fn t => Term.add_free_names t []) ts
-    val (test_funs, comp_time) =
-      cpu_time "quickcheck batch compilation" (fn () => mk_batch_tester ctxt ts) 
-    fun with_size tester k =
-      if k > size then NONE
-      else case tester k of SOME ts => SOME ts | NONE => with_size tester (k + 1)
-    val (results, exec_time) = cpu_time "quickcheck batch execution" (fn () =>
-        Option.map (map (fn test_fun => TimeLimit.timeLimit (seconds (Config.get ctxt timeout))
-              (fn () => with_size test_fun 1) ()
-             handle TimeLimit.TimeOut => NONE)) test_funs)
-  in
-    (Option.map (map2 (fn names => Option.map (fn ts => names ~~ ts)) namess) results,
-      [comp_time, exec_time])
-  end
-
-(* FIXME: this function shows that many assumptions are made upon the generation *)
-(* In the end there is probably no generic quickcheck interface left... *)
-
-fun test_term_with_increasing_cardinality compile ctxt (limit_time, is_interactive) ts =
-  let
-    val thy = Proof_Context.theory_of ctxt
-    fun message s = if Config.get ctxt quiet then () else Output.urgent_message s
-    val (ts', eval_terms) = split_list ts
-    val _ = map check_test_term ts'
-    val names = Term.add_free_names (hd ts') []
-    val Ts = map snd (Term.add_frees (hd ts') [])
-    val current_result = Unsynchronized.ref empty_result
-    fun test_card_size test_fun (card, size) =
-      (* FIXME: why decrement size by one? *)
-      let
-        val (ts, timing) =
-          cpu_time ("size " ^ string_of_int size ^ " and card " ^ string_of_int card)
-            (fn () => fst (test_fun [card, size - 1]))
-        val _ = add_timing timing current_result
-      in
-        Option.map (pair card) ts
-      end
-    val enumeration_card_size =
-      if forall (fn T => Sign.of_sort thy (T,  ["Enum.enum"])) Ts then
-        (* size does not matter *)
-        map (rpair 0) (1 upto (length ts))
-      else
-        (* size does matter *)
-        map_product pair (1 upto (length ts)) (1 upto (Config.get ctxt size))
-        |> sort (fn ((c1, s1), (c2, s2)) => int_ord ((c1 + s1), (c2 + s2)))
-  in
-    (*limit (seconds (Config.get ctxt timeout)) (limit_time, is_interactive) (fn () =>*)(
-      let
-        val (test_fun, comp_time) = cpu_time "quickcheck compilation" (fn () => compile ctxt ts)
-        val _ = add_timing comp_time current_result     
-        val _ = case get_first (test_card_size test_fun) enumeration_card_size of
-          SOME (card, ts) => add_response names (nth eval_terms (card - 1)) (SOME ts) current_result
-        | NONE => ()
-      in !current_result end)
-      (*(fn () => (message "Quickcheck ran out of time"; !current_result)) ()*)
-  end
-
-fun get_finite_types ctxt =
-  fst (chop (Config.get ctxt finite_type_size)
-    (map (Type o rpair []) ["Enum.finite_1", "Enum.finite_2", "Enum.finite_3",
-     "Enum.finite_4", "Enum.finite_5"]))
-
-exception WELLSORTED of string
-
-fun monomorphic_term thy insts default_T =
-  let
-    fun subst (T as TFree (v, S)) =
-      let
-        val T' = AList.lookup (op =) insts v
-          |> the_default default_T
-      in if Sign.of_sort thy (T', S) then T'
-        else raise (WELLSORTED ("For instantiation with default_type " ^
-          Syntax.string_of_typ_global thy default_T ^
-          ":\n" ^ Syntax.string_of_typ_global thy T' ^
-          " to be substituted for variable " ^
-          Syntax.string_of_typ_global thy T ^ " does not have sort " ^
-          Syntax.string_of_sort_global thy S))
-      end
-      | subst T = T;
-  in (map_types o map_atyps) subst end;
-
-datatype wellsorted_error = Wellsorted_Error of string | Term of term * term list
-
-fun instantiate_goals lthy insts goals =
-  let
-    fun map_goal_and_eval_terms f (check_goal, eval_terms) = (f check_goal, map f eval_terms)
-    val thy = Proof_Context.theory_of lthy
-    val default_insts =
-      if Config.get lthy finite_types then (get_finite_types lthy) else (default_type lthy)
-    val inst_goals =
-      map (fn (check_goal, eval_terms) =>
-        if not (null (Term.add_tfree_names check_goal [])) then
-          map (fn T =>
-            (pair (SOME T) o Term o apfst (Object_Logic.atomize_term thy))
-              (map_goal_and_eval_terms (monomorphic_term thy insts T) (check_goal, eval_terms))
-              handle WELLSORTED s => (SOME T, Wellsorted_Error s)) default_insts
-        else
-          [(NONE, Term (Object_Logic.atomize_term thy check_goal, eval_terms))]) goals
-    val error_msg =
-      cat_lines
-        (maps (map_filter (fn (_, Term t) => NONE | (_, Wellsorted_Error s) => SOME s)) inst_goals)
-    fun is_wellsorted_term (T, Term t) = SOME (T, t)
-      | is_wellsorted_term (_, Wellsorted_Error s) = NONE
-    val correct_inst_goals =
-      case map (map_filter is_wellsorted_term) inst_goals of
-        [[]] => error error_msg
-      | xs => xs
-    val _ = if Config.get lthy quiet then () else warning error_msg
-  in
-    correct_inst_goals
-  end
-
-fun collect_results f [] results = results
-  | collect_results f (t :: ts) results =
-    let
-      val result = f t
-    in
-      if found_counterexample result then
-        (result :: results)
-      else
-        collect_results f ts (result :: results)
-    end  
-
-fun generator_test_goal_terms compile ctxt (limit_time, is_interactive) insts goals =
-  let
-    fun test_term' goal =
-      case goal of
-        [(NONE, t)] => test_term compile ctxt (limit_time, is_interactive) t
-      | ts => test_term_with_increasing_cardinality compile ctxt (limit_time, is_interactive) (map snd ts)
-    val correct_inst_goals = instantiate_goals ctxt insts goals
-  in
-    if Config.get ctxt finite_types then
-      collect_results test_term' correct_inst_goals []
-    else
-      collect_results (test_term compile ctxt (limit_time, is_interactive))
-        (maps (map snd) correct_inst_goals) []
-  end;
-
 fun message ctxt s = if Config.get ctxt quiet then () else Output.urgent_message s
   
-fun test_goal_terms ctxt (limit_time, is_interactive) insts goals =
+fun test_terms ctxt (limit_time, is_interactive) insts goals =
   case active_testers ctxt of
     [] => error "No active testers for quickcheck"
   | testers => limit (seconds (Config.get ctxt timeout)) (limit_time, is_interactive)
@@ -524,7 +313,7 @@
         map (fn (_, phi) => (Morphism.term phi proto_goal, map (Morphism.term phi) eval_terms))
           (Locale.registrations_of (Context.Theory thy) (*FIXME*) locale);
   in
-    test_goal_terms lthy (time_limit, is_interactive) insts goals
+    test_terms lthy (time_limit, is_interactive) insts goals
   end
 
 (* pretty printing *)
@@ -537,7 +326,7 @@
         map (fn (s, t) =>
           Pretty.block [Pretty.str (s ^ " ="), Pretty.brk 1, Syntax.pretty_term ctxt t]) (rev cex))
         @ (if null eval_terms then []
-           else (Pretty.str ("Evaluated terms:\n") ::
+           else (Pretty.fbrk :: Pretty.str ("Evaluated terms:") ::
              map (fn (t, u) =>
                Pretty.block [Syntax.pretty_term ctxt t, Pretty.str " =", Pretty.brk 1,
                  Syntax.pretty_term ctxt u]) (rev eval_terms))));