src/HOL/Tools/Quickcheck/narrowing_generators.ML
changeset 42019 a9445d87bc3e
parent 41963 d8c3b26b3da4
child 42020 2da02764d523
--- a/src/HOL/Tools/Quickcheck/narrowing_generators.ML	Fri Mar 18 12:05:23 2011 +0100
+++ b/src/HOL/Tools/Quickcheck/narrowing_generators.ML	Fri Mar 18 18:19:42 2011 +0100
@@ -118,7 +118,7 @@
 fun exec verbose code =
   ML_Context.exec (fn () => Secure.use_text ML_Env.local_context (0, "generated code") verbose code)
 
-fun value ctxt (get, put, put_ml) (code, value) =
+fun value ctxt (get, put, put_ml) (code, value) size =
   let
     val tmp_prefix = "Quickcheck_Narrowing"
     fun run in_path = 
@@ -129,7 +129,7 @@
         val main = "module Main where {\n\n" ^
           "import Narrowing_Engine;\n" ^
           "import Code;\n\n" ^
-          "main = Narrowing_Engine.smallCheck 7 (Code.value ())\n\n" ^
+          "main = Narrowing_Engine.smallCheck " ^ string_of_int size ^ " (Code.value ())\n\n" ^
           "}\n"
         val code' = prefix "module Code where {\n\ndata Typerep = Typerep String [Typerep];\n"
           (unprefix "module Code where {" code)
@@ -154,18 +154,18 @@
       |> Context.proof_map (exec false ml_code);
   in get ctxt' () end;
 
-fun evaluation cookie thy evaluator vs_t args =
+fun evaluation cookie thy evaluator vs_t args size =
   let
     val ctxt = ProofContext.init_global thy;
     val (program_code, value_name) = evaluator vs_t;
     val value_code = space_implode " "
       (value_name :: "()" :: map (enclose "(" ")") args);
-  in Exn.interruptible_capture (value ctxt cookie) (program_code, value_code) end;
+  in Exn.interruptible_capture (value ctxt cookie (program_code, value_code)) size end;
 
-fun dynamic_value_strict cookie thy postproc t args =
+fun dynamic_value_strict cookie thy postproc t args size =
   let
     fun evaluator naming program ((_, vs_ty), t) deps =
-      evaluation cookie thy (Code_Target.evaluator thy target naming program deps) (vs_ty, t) args;
+      evaluation cookie thy (Code_Target.evaluator thy target naming program deps) (vs_ty, t) args size;
   in Exn.release (Code_Thingol.dynamic_value thy (Exn.map_result o postproc) evaluator t) end;
 
 (* counterexample generator *)
@@ -185,7 +185,7 @@
       Const (@{const_name Quickcheck_Narrowing.ensure_testable}, fastype_of t --> fastype_of t) $ t
     val t = dynamic_value_strict
       (Counterexample.get, Counterexample.put, "Narrowing_Generators.put_counterexample")
-      thy (Option.map o map) (ensure_testable t) []
+      thy (Option.map o map) (ensure_testable t) [] size
   in
     (t, NONE)
   end;