merged
authorhaftmann
Thu Feb 05 14:50:43 2009 +0100 (2009-02-05)
changeset 29809df25a6b1a475
parent 29805 a5da150bd0ab
parent 29808 b8b9d529663b
child 29810 fa4ec7a7215c
child 29814 15344c0899e1
merged
src/HOL/IsaMakefile
src/HOL/ex/Quickcheck.thy
src/HOL/ex/Random.thy
     1.1 --- a/src/HOL/Extraction/Higman.thy	Thu Feb 05 11:49:15 2009 +0100
     1.2 +++ b/src/HOL/Extraction/Higman.thy	Thu Feb 05 14:50:43 2009 +0100
     1.3 @@ -1,5 +1,4 @@
     1.4  (*  Title:      HOL/Extraction/Higman.thy
     1.5 -    ID:         $Id$
     1.6      Author:     Stefan Berghofer, TU Muenchen
     1.7                  Monika Seisenberger, LMU Muenchen
     1.8  *)
     1.9 @@ -7,7 +6,7 @@
    1.10  header {* Higman's lemma *}
    1.11  
    1.12  theory Higman
    1.13 -imports Main "~~/src/HOL/ex/Random"
    1.14 +imports Main State_Monad Random
    1.15  begin
    1.16  
    1.17  text {*
     2.1 --- a/src/HOL/IsaMakefile	Thu Feb 05 11:49:15 2009 +0100
     2.2 +++ b/src/HOL/IsaMakefile	Thu Feb 05 14:50:43 2009 +0100
     2.3 @@ -311,6 +311,7 @@
     2.4  
     2.5  HOL-Library: HOL $(LOG)/HOL-Library.gz
     2.6  
     2.7 +
     2.8  $(LOG)/HOL-Library.gz: $(OUT)/HOL Library/SetsAndFunctions.thy		\
     2.9    Library/Abstract_Rat.thy \
    2.10    Library/BigO.thy Library/ContNotDenum.thy Library/Efficient_Nat.thy	\
    2.11 @@ -335,7 +336,8 @@
    2.12    Library/Mapping.thy	Library/Numeral_Type.thy	Library/Reflection.thy		\
    2.13    Library/Boolean_Algebra.thy Library/Countable.thy	\
    2.14    Library/RBT.thy	Library/Univ_Poly.thy	\
    2.15 -  Library/Enum.thy Library/Float.thy $(SRC)/Tools/float.ML \
    2.16 +  Library/Random.thy	Library/Quickcheck.thy	\
    2.17 +  Library/Enum.thy Library/Float.thy $(SRC)/Tools/float.ML $(SRC)/HOL/Tools/float_arith.ML \
    2.18    Library/reify_data.ML Library/reflection.ML
    2.19  	@cd Library; $(ISABELLE_TOOL) usedir $(OUT)/HOL Library
    2.20  
    2.21 @@ -815,7 +817,7 @@
    2.22    ex/Abstract_NAT.thy ex/Antiquote.thy ex/Arith_Examples.thy ex/BT.thy	\
    2.23    ex/BinEx.thy ex/CTL.thy ex/Chinese.thy ex/Classical.thy		\
    2.24    ex/Coherent.thy ex/Dense_Linear_Order_Ex.thy ex/Eval_Examples.thy	\
    2.25 -  ex/Groebner_Examples.thy ex/Random.thy ex/Quickcheck.thy		\
    2.26 +  ex/Groebner_Examples.thy ex/Quickcheck_Generators.thy		\
    2.27    ex/Codegenerator.thy ex/Codegenerator_Pretty.thy			\
    2.28    ex/CodegenSML_Test.thy ex/Formal_Power_Series_Examples.thy						\
    2.29    ex/Commutative_RingEx.thy ex/Efficient_Nat_examples.thy		\
     3.1 --- a/src/HOL/Library/Library.thy	Thu Feb 05 11:49:15 2009 +0100
     3.2 +++ b/src/HOL/Library/Library.thy	Thu Feb 05 14:50:43 2009 +0100
     3.3 @@ -34,9 +34,11 @@
     3.4    Permutation
     3.5    Pocklington
     3.6    Primes
     3.7 +  Quickcheck
     3.8    Quicksort
     3.9    Quotient
    3.10    Ramsey
    3.11 +  Random
    3.12    Reflection
    3.13    RBT
    3.14    State_Monad
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/HOL/Library/Quickcheck.thy	Thu Feb 05 14:50:43 2009 +0100
     4.3 @@ -0,0 +1,85 @@
     4.4 +(* Author: Florian Haftmann, TU Muenchen *)
     4.5 +
     4.6 +header {* A simple counterexample generator *}
     4.7 +
     4.8 +theory Quickcheck
     4.9 +imports Random Code_Eval Map
    4.10 +begin
    4.11 +
    4.12 +subsection {* The @{text random} class *}
    4.13 +
    4.14 +class random = typerep +
    4.15 +  fixes random :: "index \<Rightarrow> seed \<Rightarrow> ('a \<times> (unit \<Rightarrow> term)) \<times> seed"
    4.16 +
    4.17 +text {* Type @{typ "'a itself"} *}
    4.18 +
    4.19 +instantiation itself :: ("{type, typerep}") random
    4.20 +begin
    4.21 +
    4.22 +definition
    4.23 +  "random _ = return (TYPE('a), \<lambda>u. Code_Eval.Const (STR ''TYPE'') TYPEREP('a))"
    4.24 +
    4.25 +instance ..
    4.26 +
    4.27 +end
    4.28 +
    4.29 +
    4.30 +subsection {* Quickcheck generator *}
    4.31 +
    4.32 +ML {*
    4.33 +structure StateMonad =
    4.34 +struct
    4.35 +
    4.36 +fun liftT T sT = sT --> HOLogic.mk_prodT (T, sT);
    4.37 +fun liftT' sT = sT --> sT;
    4.38 +
    4.39 +fun return T sT x = Const (@{const_name Pair}, T --> liftT T sT) $ x;
    4.40 +
    4.41 +fun scomp T1 T2 sT f g = Const (@{const_name scomp},
    4.42 +  liftT T1 sT --> (T1 --> liftT T2 sT) --> liftT T2 sT) $ f $ g;
    4.43 +
    4.44 +end;
    4.45 +
    4.46 +structure Quickcheck =
    4.47 +struct
    4.48 +
    4.49 +open Quickcheck;
    4.50 +
    4.51 +val eval_ref : (unit -> int -> int * int -> term list option * (int * int)) option ref = ref NONE;
    4.52 +
    4.53 +fun mk_generator_expr thy prop tys =
    4.54 +  let
    4.55 +    val bound_max = length tys - 1;
    4.56 +    val bounds = map_index (fn (i, ty) =>
    4.57 +      (2 * (bound_max - i) + 1, 2 * (bound_max - i), 2 * i, ty)) tys;
    4.58 +    val result = list_comb (prop, map (fn (i, _, _, _) => Bound i) bounds);
    4.59 +    val terms = HOLogic.mk_list @{typ term} (map (fn (_, i, _, _) => Bound i $ @{term "()"}) bounds);
    4.60 +    val check = @{term "If \<Colon> bool \<Rightarrow> term list option \<Rightarrow> term list option \<Rightarrow> term list option"}
    4.61 +      $ result $ @{term "None \<Colon> term list option"} $ (@{term "Some \<Colon> term list \<Rightarrow> term list option "} $ terms);
    4.62 +    val return = @{term "Pair \<Colon> term list option \<Rightarrow> seed \<Rightarrow> term list option \<times> seed"};
    4.63 +    fun mk_termtyp ty = HOLogic.mk_prodT (ty, @{typ "unit \<Rightarrow> term"});
    4.64 +    fun mk_split ty = Sign.mk_const thy
    4.65 +      (@{const_name split}, [ty, @{typ "unit \<Rightarrow> term"}, StateMonad.liftT @{typ "term list option"} @{typ seed}]);
    4.66 +    fun mk_scomp_split ty t t' =
    4.67 +      StateMonad.scomp (mk_termtyp ty) @{typ "term list option"} @{typ seed} t (*FIXME*)
    4.68 +        (mk_split ty $ Abs ("", ty, Abs ("", @{typ "unit \<Rightarrow> term"}, t')));
    4.69 +    fun mk_bindclause (_, _, i, ty) = mk_scomp_split ty
    4.70 +      (Sign.mk_const thy (@{const_name random}, [ty]) $ Bound i)
    4.71 +    val t = fold_rev mk_bindclause bounds (return $ check);
    4.72 +  in Abs ("n", @{typ index}, t) end;
    4.73 +
    4.74 +fun compile_generator_expr thy t =
    4.75 +  let
    4.76 +    val tys = (map snd o fst o strip_abs) t;
    4.77 +    val t' = mk_generator_expr thy t tys;
    4.78 +    val f = Code_ML.eval_term ("Quickcheck.eval_ref", eval_ref) thy t' [];
    4.79 +  in f #> Random_Engine.run #> (Option.map o map) (Code.postprocess_term thy) end;
    4.80 +
    4.81 +end
    4.82 +*}
    4.83 +
    4.84 +setup {*
    4.85 +  Quickcheck.add_generator ("code", Quickcheck.compile_generator_expr o ProofContext.theory_of)
    4.86 +*}
    4.87 +
    4.88 +end
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOL/Library/Random.thy	Thu Feb 05 14:50:43 2009 +0100
     5.3 @@ -0,0 +1,182 @@
     5.4 +(*  Author:     Florian Haftmann, TU Muenchen
     5.5 +*)
     5.6 +
     5.7 +header {* A HOL random engine *}
     5.8 +
     5.9 +theory Random
    5.10 +imports State_Monad Code_Index
    5.11 +begin
    5.12 +
    5.13 +subsection {* Auxiliary functions *}
    5.14 +
    5.15 +definition
    5.16 +  inc_shift :: "index \<Rightarrow> index \<Rightarrow> index"
    5.17 +where
    5.18 +  "inc_shift v k = (if v = k then 1 else k + 1)"
    5.19 +
    5.20 +definition
    5.21 +  minus_shift :: "index \<Rightarrow> index \<Rightarrow> index \<Rightarrow> index"
    5.22 +where
    5.23 +  "minus_shift r k l = (if k < l then r + k - l else k - l)"
    5.24 +
    5.25 +fun
    5.26 +  log :: "index \<Rightarrow> index \<Rightarrow> index"
    5.27 +where
    5.28 +  "log b i = (if b \<le> 1 \<or> i < b then 1 else 1 + log b (i div b))"
    5.29 +
    5.30 +subsection {* Random seeds *}
    5.31 +
    5.32 +types seed = "index \<times> index"
    5.33 +
    5.34 +primrec
    5.35 +  "next" :: "seed \<Rightarrow> index \<times> seed"
    5.36 +where
    5.37 +  "next (v, w) = (let
    5.38 +     k =  v div 53668;
    5.39 +     v' = minus_shift 2147483563 (40014 * (v mod 53668)) (k * 12211);
    5.40 +     l =  w div 52774;
    5.41 +     w' = minus_shift 2147483399 (40692 * (w mod 52774)) (l * 3791);
    5.42 +     z =  minus_shift 2147483562 v' (w' + 1) + 1
    5.43 +   in (z, (v', w')))"
    5.44 +
    5.45 +lemma next_not_0:
    5.46 +  "fst (next s) \<noteq> 0"
    5.47 +apply (cases s)
    5.48 +apply (auto simp add: minus_shift_def Let_def)
    5.49 +done
    5.50 +
    5.51 +primrec
    5.52 +  seed_invariant :: "seed \<Rightarrow> bool"
    5.53 +where
    5.54 +  "seed_invariant (v, w) \<longleftrightarrow> 0 < v \<and> v < 9438322952 \<and> 0 < w \<and> True"
    5.55 +
    5.56 +lemma if_same:
    5.57 +  "(if b then f x else f y) = f (if b then x else y)"
    5.58 +  by (cases b) simp_all
    5.59 +
    5.60 +definition
    5.61 +  split_seed :: "seed \<Rightarrow> seed \<times> seed"
    5.62 +where
    5.63 +  "split_seed s = (let
    5.64 +     (v, w) = s;
    5.65 +     (v', w') = snd (next s);
    5.66 +     v'' = inc_shift 2147483562 v;
    5.67 +     s'' = (v'', w');
    5.68 +     w'' = inc_shift 2147483398 w;
    5.69 +     s''' = (v', w'')
    5.70 +   in (s'', s'''))"
    5.71 +
    5.72 +
    5.73 +subsection {* Base selectors *}
    5.74 +
    5.75 +function
    5.76 +  range_aux :: "index \<Rightarrow> index \<Rightarrow> seed \<Rightarrow> index \<times> seed"
    5.77 +where
    5.78 +  "range_aux k l s = (if k = 0 then (l, s) else
    5.79 +    let (v, s') = next s
    5.80 +  in range_aux (k - 1) (v + l * 2147483561) s')"
    5.81 +by pat_completeness auto
    5.82 +termination
    5.83 +  by (relation "measure (nat_of_index o fst)")
    5.84 +    (auto simp add: index)
    5.85 +
    5.86 +definition
    5.87 +  range :: "index \<Rightarrow> seed \<Rightarrow> index \<times> seed"
    5.88 +where
    5.89 +  "range k = (do
    5.90 +     v \<leftarrow> range_aux (log 2147483561 k) 1;
    5.91 +     return (v mod k)
    5.92 +   done)"
    5.93 +
    5.94 +lemma range:
    5.95 +  assumes "k > 0"
    5.96 +  shows "fst (range k s) < k"
    5.97 +proof -
    5.98 +  obtain v w where range_aux:
    5.99 +    "range_aux (log 2147483561 k) 1 s = (v, w)"
   5.100 +    by (cases "range_aux (log 2147483561 k) 1 s")
   5.101 +  with assms show ?thesis
   5.102 +    by (simp add: monad_collapse range_def del: range_aux.simps log.simps)
   5.103 +qed
   5.104 +
   5.105 +definition
   5.106 +  select :: "'a list \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
   5.107 +where
   5.108 +  "select xs = (do
   5.109 +     k \<leftarrow> range (index_of_nat (length xs));
   5.110 +     return (nth xs (nat_of_index k))
   5.111 +   done)"
   5.112 +
   5.113 +lemma select:
   5.114 +  assumes "xs \<noteq> []"
   5.115 +  shows "fst (select xs s) \<in> set xs"
   5.116 +proof -
   5.117 +  from assms have "index_of_nat (length xs) > 0" by simp
   5.118 +  with range have
   5.119 +    "fst (range (index_of_nat (length xs)) s) < index_of_nat (length xs)" by best
   5.120 +  then have
   5.121 +    "nat_of_index (fst (range (index_of_nat (length xs)) s)) < length xs" by simp
   5.122 +  then show ?thesis
   5.123 +    by (auto simp add: monad_collapse select_def)
   5.124 +qed
   5.125 +
   5.126 +definition
   5.127 +  select_default :: "index \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
   5.128 +where
   5.129 +  [code del]: "select_default k x y = (do
   5.130 +     l \<leftarrow> range k;
   5.131 +     return (if l + 1 < k then x else y)
   5.132 +   done)"
   5.133 +
   5.134 +lemma select_default_zero:
   5.135 +  "fst (select_default 0 x y s) = y"
   5.136 +  by (simp add: monad_collapse select_default_def)
   5.137 +
   5.138 +lemma select_default_code [code]:
   5.139 +  "select_default k x y = (if k = 0 then do
   5.140 +     _ \<leftarrow> range 1;
   5.141 +     return y
   5.142 +   done else do
   5.143 +     l \<leftarrow> range k;
   5.144 +     return (if l + 1 < k then x else y)
   5.145 +   done)"
   5.146 +proof (cases "k = 0")
   5.147 +  case False then show ?thesis by (simp add: select_default_def)
   5.148 +next
   5.149 +  case True then show ?thesis
   5.150 +    by (simp add: monad_collapse select_default_def range_def)
   5.151 +qed
   5.152 +
   5.153 +
   5.154 +subsection {* @{text ML} interface *}
   5.155 +
   5.156 +ML {*
   5.157 +structure Random_Engine =
   5.158 +struct
   5.159 +
   5.160 +type seed = int * int;
   5.161 +
   5.162 +local
   5.163 +
   5.164 +val seed = ref 
   5.165 +  (let
   5.166 +    val now = Time.toMilliseconds (Time.now ());
   5.167 +    val (q, s1) = IntInf.divMod (now, 2147483562);
   5.168 +    val s2 = q mod 2147483398;
   5.169 +  in (s1 + 1, s2 + 1) end);
   5.170 +
   5.171 +in
   5.172 +
   5.173 +fun run f =
   5.174 +  let
   5.175 +    val (x, seed') = f (! seed);
   5.176 +    val _ = seed := seed'
   5.177 +  in x end;
   5.178 +
   5.179 +end;
   5.180 +
   5.181 +end;
   5.182 +*}
   5.183 +
   5.184 +end
   5.185 +
     6.1 --- a/src/HOL/Tools/primrec_package.ML	Thu Feb 05 11:49:15 2009 +0100
     6.2 +++ b/src/HOL/Tools/primrec_package.ML	Thu Feb 05 14:50:43 2009 +0100
     6.3 @@ -247,11 +247,11 @@
     6.4      val _ = if gen_eq_set (op =) (names1, names2) then ()
     6.5        else primrec_error ("functions " ^ commas_quote names2 ^
     6.6          "\nare not mutually recursive");
     6.7 -    val qualify = Binding.qualify
     6.8 -      (space_implode "_" (map (Sign.base_name o #1) defs));
     6.9 -    val spec' = (map o apfst o apfst) qualify spec;
    6.10 -    val simp_atts = map (Attrib.internal o K)
    6.11 -      [Simplifier.simp_add, Code.add_default_eqn_attribute];
    6.12 +    val prefix = space_implode "_" (map (Sign.base_name o #1) defs);
    6.13 +    val qualify = Binding.qualify prefix;
    6.14 +    val spec' = (map o apfst)
    6.15 +      (fn (b, attrs) => (qualify b, Code.add_default_eqn_attrib :: attrs)) spec;
    6.16 +    val simp_att = (Attrib.internal o K) Simplifier.simp_add;
    6.17    in
    6.18      lthy
    6.19      |> set_group ? LocalTheory.set_group (serial_string ())
    6.20 @@ -259,7 +259,7 @@
    6.21      |-> (fn defs => `(fn ctxt => prove_spec ctxt names1 rec_rewrites defs spec'))
    6.22      |-> (fn simps => fold_map (LocalTheory.note Thm.theoremK) simps)
    6.23      |-> (fn simps' => LocalTheory.note Thm.theoremK
    6.24 -          ((qualify (Binding.name "simps"), simp_atts), maps snd simps'))
    6.25 +          ((qualify (Binding.name "simps"), [simp_att]), maps snd simps'))
    6.26      |>> snd
    6.27    end handle PrimrecError (msg, some_eqn) =>
    6.28      error ("Primrec definition error:\n" ^ msg ^ (case some_eqn
     7.1 --- a/src/HOL/ex/Quickcheck.thy	Thu Feb 05 11:49:15 2009 +0100
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,413 +0,0 @@
     7.4 -(* Author: Florian Haftmann, TU Muenchen *)
     7.5 -
     7.6 -header {* A simple counterexample generator *}
     7.7 -
     7.8 -theory Quickcheck
     7.9 -imports Random Code_Eval Map
    7.10 -begin
    7.11 -
    7.12 -subsection {* The @{text random} class *}
    7.13 -
    7.14 -class random = typerep +
    7.15 -  fixes random :: "index \<Rightarrow> seed \<Rightarrow> ('a \<times> (unit \<Rightarrow> term)) \<times> seed"
    7.16 -
    7.17 -text {* Type @{typ "'a itself"} *}
    7.18 -
    7.19 -instantiation itself :: ("{type, typerep}") random
    7.20 -begin
    7.21 -
    7.22 -definition
    7.23 -  "random _ = return (TYPE('a), \<lambda>u. Code_Eval.Const (STR ''TYPE'') TYPEREP('a))"
    7.24 -
    7.25 -instance ..
    7.26 -
    7.27 -end
    7.28 -
    7.29 -text {* Type @{typ "'a \<Rightarrow> 'b"} *}
    7.30 -
    7.31 -ML {*
    7.32 -structure Random_Engine =
    7.33 -struct
    7.34 -
    7.35 -open Random_Engine;
    7.36 -
    7.37 -fun random_fun (T1 : typ) (T2 : typ) (eq : 'a -> 'a -> bool) (term_of : 'a -> term)
    7.38 -    (random : Random_Engine.seed -> ('b * (unit -> term)) * Random_Engine.seed)
    7.39 -    (random_split : Random_Engine.seed -> Random_Engine.seed * Random_Engine.seed)
    7.40 -    (seed : Random_Engine.seed) =
    7.41 -  let
    7.42 -    val (seed', seed'') = random_split seed;
    7.43 -    val state = ref (seed', [], Const (@{const_name undefined}, T1 --> T2));
    7.44 -    val fun_upd = Const (@{const_name fun_upd},
    7.45 -      (T1 --> T2) --> T1 --> T2 --> T1 --> T2);
    7.46 -    fun random_fun' x =
    7.47 -      let
    7.48 -        val (seed, fun_map, f_t) = ! state;
    7.49 -      in case AList.lookup (uncurry eq) fun_map x
    7.50 -       of SOME y => y
    7.51 -        | NONE => let
    7.52 -              val t1 = term_of x;
    7.53 -              val ((y, t2), seed') = random seed;
    7.54 -              val fun_map' = (x, y) :: fun_map;
    7.55 -              val f_t' = fun_upd $ f_t $ t1 $ t2 ();
    7.56 -              val _ = state := (seed', fun_map', f_t');
    7.57 -            in y end
    7.58 -      end;
    7.59 -    fun term_fun' () = #3 (! state);
    7.60 -  in ((random_fun', term_fun'), seed'') end;
    7.61 -
    7.62 -end
    7.63 -*}
    7.64 -
    7.65 -axiomatization
    7.66 -  random_fun_aux :: "typerep \<Rightarrow> typerep \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> term)
    7.67 -    \<Rightarrow> (seed \<Rightarrow> ('b \<times> (unit \<Rightarrow> term)) \<times> seed) \<Rightarrow> (seed \<Rightarrow> seed \<times> seed)
    7.68 -    \<Rightarrow> seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> seed"
    7.69 -
    7.70 -code_const random_fun_aux (SML "Random'_Engine.random'_fun")
    7.71 -
    7.72 -instantiation "fun" :: ("{eq, term_of}", "{type, random}") random
    7.73 -begin
    7.74 -
    7.75 -definition random_fun :: "index \<Rightarrow> seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> seed" where
    7.76 -  "random n = random_fun_aux TYPEREP('a) TYPEREP('b) (op =) Code_Eval.term_of (random n) split_seed"
    7.77 -
    7.78 -instance ..
    7.79 -
    7.80 -end
    7.81 -
    7.82 -code_reserved SML Random_Engine
    7.83 -
    7.84 -text {* Datatypes *}
    7.85 -
    7.86 -definition
    7.87 -  collapse :: "('a \<Rightarrow> ('a \<Rightarrow> 'b \<times> 'a) \<times> 'a) \<Rightarrow> 'a \<Rightarrow> 'b \<times> 'a" where
    7.88 -  "collapse f = (do g \<leftarrow> f; g done)"
    7.89 -
    7.90 -ML {*
    7.91 -structure StateMonad =
    7.92 -struct
    7.93 -
    7.94 -fun liftT T sT = sT --> HOLogic.mk_prodT (T, sT);
    7.95 -fun liftT' sT = sT --> sT;
    7.96 -
    7.97 -fun return T sT x = Const (@{const_name return}, T --> liftT T sT) $ x;
    7.98 -
    7.99 -fun scomp T1 T2 sT f g = Const (@{const_name scomp},
   7.100 -  liftT T1 sT --> (T1 --> liftT T2 sT) --> liftT T2 sT) $ f $ g;
   7.101 -
   7.102 -end;
   7.103 -*}
   7.104 -
   7.105 -lemma random'_if:
   7.106 -  fixes random' :: "index \<Rightarrow> index \<Rightarrow> seed \<Rightarrow> ('a \<times> (unit \<Rightarrow> term)) \<times> seed"
   7.107 -  assumes "random' 0 j = (\<lambda>s. undefined)"
   7.108 -    and "\<And>i. random' (Suc_index i) j = rhs2 i"
   7.109 -  shows "random' i j s = (if i = 0 then undefined else rhs2 (i - 1) s)"
   7.110 -  by (cases i rule: index.exhaust) (insert assms, simp_all)
   7.111 -
   7.112 -setup {*
   7.113 -let
   7.114 -  exception REC of string;
   7.115 -  exception TYP of string;
   7.116 -  fun mk_collapse thy ty = Sign.mk_const thy
   7.117 -    (@{const_name collapse}, [@{typ seed}, ty]);
   7.118 -  fun term_ty ty = HOLogic.mk_prodT (ty, @{typ "unit \<Rightarrow> term"});
   7.119 -  fun mk_split thy ty ty' = Sign.mk_const thy
   7.120 -    (@{const_name split}, [ty, @{typ "unit \<Rightarrow> term"}, StateMonad.liftT (term_ty ty') @{typ seed}]);
   7.121 -  fun mk_scomp_split thy ty ty' t t' =
   7.122 -    StateMonad.scomp (term_ty ty) (term_ty ty') @{typ seed} t
   7.123 -      (mk_split thy ty ty' $ Abs ("", ty, Abs ("", @{typ "unit \<Rightarrow> term"}, t')))
   7.124 -  fun mk_cons thy this_ty (c, args) =
   7.125 -    let
   7.126 -      val tys = map (fst o fst) args;
   7.127 -      val c_ty = tys ---> this_ty;
   7.128 -      val c = Const (c, tys ---> this_ty);
   7.129 -      val t_indices = map (curry ( op * ) 2) (length tys - 1 downto 0);
   7.130 -      val c_indices = map (curry ( op + ) 1) t_indices;
   7.131 -      val c_t = list_comb (c, map Bound c_indices);
   7.132 -      val t_t = Abs ("", @{typ unit}, Eval.mk_term Free Typerep.typerep
   7.133 -        (list_comb (c, map (fn k => Bound (k + 1)) t_indices))
   7.134 -        |> map_aterms (fn t as Bound _ => t $ @{term "()"} | t => t));
   7.135 -      val return = StateMonad.return (term_ty this_ty) @{typ seed}
   7.136 -        (HOLogic.mk_prod (c_t, t_t));
   7.137 -      val t = fold_rev (fn ((ty, _), random) =>
   7.138 -        mk_scomp_split thy ty this_ty random)
   7.139 -          args return;
   7.140 -      val is_rec = exists (snd o fst) args;
   7.141 -    in (is_rec, t) end;
   7.142 -  fun mk_conss thy ty [] = NONE
   7.143 -    | mk_conss thy ty [(_, t)] = SOME t
   7.144 -    | mk_conss thy ty ts = SOME (mk_collapse thy (term_ty ty) $
   7.145 -          (Sign.mk_const thy (@{const_name select}, [StateMonad.liftT (term_ty ty) @{typ seed}]) $
   7.146 -            HOLogic.mk_list (StateMonad.liftT (term_ty ty) @{typ seed}) (map snd ts)));
   7.147 -  fun mk_clauses thy ty (tyco, (ts_rec, ts_atom)) = 
   7.148 -    let
   7.149 -      val SOME t_atom = mk_conss thy ty ts_atom;
   7.150 -    in case mk_conss thy ty ts_rec
   7.151 -     of SOME t_rec => mk_collapse thy (term_ty ty) $
   7.152 -          (Sign.mk_const thy (@{const_name select_default}, [StateMonad.liftT (term_ty ty) @{typ seed}]) $
   7.153 -             @{term "i\<Colon>index"} $ t_rec $ t_atom)
   7.154 -      | NONE => t_atom
   7.155 -    end;
   7.156 -  fun mk_random_eqs thy vs tycos =
   7.157 -    let
   7.158 -      val this_ty = Type (hd tycos, map TFree vs);
   7.159 -      val this_ty' = StateMonad.liftT (term_ty this_ty) @{typ seed};
   7.160 -      val random_name = NameSpace.base @{const_name random};
   7.161 -      val random'_name = random_name ^ "_" ^ Class.type_name (hd tycos) ^ "'";
   7.162 -      fun random ty = Sign.mk_const thy (@{const_name random}, [ty]);
   7.163 -      val random' = Free (random'_name,
   7.164 -        @{typ index} --> @{typ index} --> this_ty');
   7.165 -      fun atom ty = if Sign.of_sort thy (ty, @{sort random})
   7.166 -        then ((ty, false), random ty $ @{term "j\<Colon>index"})
   7.167 -        else raise TYP
   7.168 -          ("Will not generate random elements for type(s) " ^ quote (hd tycos));
   7.169 -      fun dtyp tyco = ((this_ty, true), random' $ @{term "i\<Colon>index"} $ @{term "j\<Colon>index"});
   7.170 -      fun rtyp tyco tys = raise REC
   7.171 -        ("Will not generate random elements for mutual recursive type " ^ quote (hd tycos));
   7.172 -      val rhss = DatatypePackage.construction_interpretation thy
   7.173 -            { atom = atom, dtyp = dtyp, rtyp = rtyp } vs tycos
   7.174 -        |> (map o apsnd o map) (mk_cons thy this_ty) 
   7.175 -        |> (map o apsnd) (List.partition fst)
   7.176 -        |> map (mk_clauses thy this_ty)
   7.177 -      val eqss = map ((apsnd o map) (HOLogic.mk_Trueprop o HOLogic.mk_eq) o (fn rhs => ((this_ty, random'), [
   7.178 -          (random' $ @{term "0\<Colon>index"} $ @{term "j\<Colon>index"}, Abs ("s", @{typ seed},
   7.179 -            Const (@{const_name undefined}, HOLogic.mk_prodT (term_ty this_ty, @{typ seed})))),
   7.180 -          (random' $ @{term "Suc_index i"} $ @{term "j\<Colon>index"}, rhs)
   7.181 -        ]))) rhss;
   7.182 -    in eqss end;
   7.183 -  fun random_inst [tyco] thy =
   7.184 -        let
   7.185 -          val (raw_vs, _) = DatatypePackage.the_datatype_spec thy tyco;
   7.186 -          val vs = (map o apsnd)
   7.187 -            (curry (Sorts.inter_sort (Sign.classes_of thy)) @{sort random}) raw_vs;
   7.188 -          val ((this_ty, random'), eqs') = singleton (mk_random_eqs thy vs) tyco;
   7.189 -          val eq = (HOLogic.mk_Trueprop o HOLogic.mk_eq)
   7.190 -            (Sign.mk_const thy (@{const_name random}, [this_ty]) $ @{term "i\<Colon>index"},
   7.191 -               random' $ @{term "i\<Colon>index"} $ @{term "i\<Colon>index"})
   7.192 -          val del_func = Attrib.internal (fn _ => Thm.declaration_attribute
   7.193 -            (fn thm => Context.mapping (Code.del_eqn thm) I));
   7.194 -          fun add_code simps lthy =
   7.195 -            let
   7.196 -              val thy = ProofContext.theory_of lthy;
   7.197 -              val thm = @{thm random'_if}
   7.198 -                |> Drule.instantiate' [SOME (Thm.ctyp_of thy this_ty)] [SOME (Thm.cterm_of thy random')]
   7.199 -                |> (fn thm => thm OF simps)
   7.200 -                |> singleton (ProofContext.export lthy (ProofContext.init thy));
   7.201 -              val c = (fst o dest_Const o fst o strip_comb o fst
   7.202 -                o HOLogic.dest_eq o HOLogic.dest_Trueprop o Thm.prop_of) thm;
   7.203 -            in
   7.204 -              lthy
   7.205 -              |> LocalTheory.theory (Code.del_eqns c
   7.206 -                   #> PureThy.add_thm ((Binding.name (fst (dest_Free random') ^ "_code"), thm), [Thm.kind_internal])
   7.207 -                   #-> Code.add_eqn)
   7.208 -            end;
   7.209 -        in
   7.210 -          thy
   7.211 -          |> TheoryTarget.instantiation ([tyco], vs, @{sort random})
   7.212 -          |> PrimrecPackage.add_primrec
   7.213 -               [(Binding.name (fst (dest_Free random')), SOME (snd (dest_Free random')), NoSyn)]
   7.214 -                 (map (fn eq => ((Binding.empty, [del_func]), eq)) eqs')
   7.215 -          |-> add_code
   7.216 -          |> `(fn lthy => Syntax.check_term lthy eq)
   7.217 -          |-> (fn eq => Specification.definition (NONE, (Attrib.empty_binding, eq)))
   7.218 -          |> snd
   7.219 -          |> Class.prove_instantiation_instance (K (Class.intro_classes_tac []))
   7.220 -          |> LocalTheory.exit_global
   7.221 -        end
   7.222 -    | random_inst tycos thy = raise REC
   7.223 -        ("Will not generate random elements for mutual recursive type(s) " ^ commas (map quote tycos));
   7.224 -  fun add_random_inst tycos thy = random_inst tycos thy
   7.225 -     handle REC msg => (warning msg; thy)
   7.226 -          | TYP msg => (warning msg; thy)
   7.227 -in DatatypePackage.interpretation add_random_inst end
   7.228 -*}
   7.229 -
   7.230 -text {* Type @{typ int} *}
   7.231 -
   7.232 -instantiation int :: random
   7.233 -begin
   7.234 -
   7.235 -definition
   7.236 -  "random n = (do
   7.237 -     (b, _) \<leftarrow> random n;
   7.238 -     (m, t) \<leftarrow> random n;
   7.239 -     return (if b then (int m, \<lambda>u. Code_Eval.App (Code_Eval.Const (STR ''Int.int'') TYPEREP(nat \<Rightarrow> int)) (t ()))
   7.240 -       else (- int m, \<lambda>u. Code_Eval.App (Code_Eval.Const (STR ''HOL.uminus_class.uminus'') TYPEREP(int \<Rightarrow> int))
   7.241 -         (Code_Eval.App (Code_Eval.Const (STR ''Int.int'') TYPEREP(nat \<Rightarrow> int)) (t ()))))
   7.242 -   done)"
   7.243 -
   7.244 -instance ..
   7.245 -
   7.246 -end
   7.247 -
   7.248 -
   7.249 -subsection {* Quickcheck generator *}
   7.250 -
   7.251 -ML {*
   7.252 -structure Quickcheck =
   7.253 -struct
   7.254 -
   7.255 -open Quickcheck;
   7.256 -
   7.257 -val eval_ref : (unit -> int -> int * int -> term list option * (int * int)) option ref = ref NONE;
   7.258 -
   7.259 -fun mk_generator_expr thy prop tys =
   7.260 -  let
   7.261 -    val bound_max = length tys - 1;
   7.262 -    val bounds = map_index (fn (i, ty) =>
   7.263 -      (2 * (bound_max - i) + 1, 2 * (bound_max - i), 2 * i, ty)) tys;
   7.264 -    val result = list_comb (prop, map (fn (i, _, _, _) => Bound i) bounds);
   7.265 -    val terms = HOLogic.mk_list @{typ term} (map (fn (_, i, _, _) => Bound i $ @{term "()"}) bounds);
   7.266 -    val check = @{term "If \<Colon> bool \<Rightarrow> term list option \<Rightarrow> term list option \<Rightarrow> term list option"}
   7.267 -      $ result $ @{term "None \<Colon> term list option"} $ (@{term "Some \<Colon> term list \<Rightarrow> term list option "} $ terms);
   7.268 -    val return = @{term "Pair \<Colon> term list option \<Rightarrow> seed \<Rightarrow> term list option \<times> seed"};
   7.269 -    fun mk_termtyp ty = HOLogic.mk_prodT (ty, @{typ "unit \<Rightarrow> term"});
   7.270 -    fun mk_split ty = Sign.mk_const thy
   7.271 -      (@{const_name split}, [ty, @{typ "unit \<Rightarrow> term"}, StateMonad.liftT @{typ "term list option"} @{typ seed}]);
   7.272 -    fun mk_scomp_split ty t t' =
   7.273 -      StateMonad.scomp (mk_termtyp ty) @{typ "term list option"} @{typ seed} t (*FIXME*)
   7.274 -        (mk_split ty $ Abs ("", ty, Abs ("", @{typ "unit \<Rightarrow> term"}, t')));
   7.275 -    fun mk_bindclause (_, _, i, ty) = mk_scomp_split ty
   7.276 -      (Sign.mk_const thy (@{const_name random}, [ty]) $ Bound i)
   7.277 -    val t = fold_rev mk_bindclause bounds (return $ check);
   7.278 -  in Abs ("n", @{typ index}, t) end;
   7.279 -
   7.280 -fun compile_generator_expr thy t =
   7.281 -  let
   7.282 -    val tys = (map snd o fst o strip_abs) t;
   7.283 -    val t' = mk_generator_expr thy t tys;
   7.284 -    val f = Code_ML.eval_term ("Quickcheck.eval_ref", eval_ref) thy t' [];
   7.285 -  in f #> Random_Engine.run #> (Option.map o map) (Code.postprocess_term thy) end;
   7.286 -
   7.287 -end
   7.288 -*}
   7.289 -
   7.290 -setup {*
   7.291 -  Quickcheck.add_generator ("code", Quickcheck.compile_generator_expr o ProofContext.theory_of)
   7.292 -*}
   7.293 -
   7.294 -subsection {* Examples *}
   7.295 -
   7.296 -theorem "map g (map f xs) = map (g o f) xs"
   7.297 -  quickcheck [generator = code]
   7.298 -  by (induct xs) simp_all
   7.299 -
   7.300 -theorem "map g (map f xs) = map (f o g) xs"
   7.301 -  quickcheck [generator = code]
   7.302 -  oops
   7.303 -
   7.304 -theorem "rev (xs @ ys) = rev ys @ rev xs"
   7.305 -  quickcheck [generator = code]
   7.306 -  by simp
   7.307 -
   7.308 -theorem "rev (xs @ ys) = rev xs @ rev ys"
   7.309 -  quickcheck [generator = code]
   7.310 -  oops
   7.311 -
   7.312 -theorem "rev (rev xs) = xs"
   7.313 -  quickcheck [generator = code]
   7.314 -  by simp
   7.315 -
   7.316 -theorem "rev xs = xs"
   7.317 -  quickcheck [generator = code]
   7.318 -  oops
   7.319 -
   7.320 -primrec app :: "('a \<Rightarrow> 'a) list \<Rightarrow> 'a \<Rightarrow> 'a" where
   7.321 -  "app [] x = x"
   7.322 -  | "app (f # fs) x = app fs (f x)"
   7.323 -
   7.324 -lemma "app (fs @ gs) x = app gs (app fs x)"
   7.325 -  quickcheck [generator = code]
   7.326 -  by (induct fs arbitrary: x) simp_all
   7.327 -
   7.328 -lemma "app (fs @ gs) x = app fs (app gs x)"
   7.329 -  quickcheck [generator = code]
   7.330 -  oops
   7.331 -
   7.332 -primrec occurs :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
   7.333 -  "occurs a [] = 0"
   7.334 -  | "occurs a (x#xs) = (if (x=a) then Suc(occurs a xs) else occurs a xs)"
   7.335 -
   7.336 -primrec del1 :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   7.337 -  "del1 a [] = []"
   7.338 -  | "del1 a (x#xs) = (if (x=a) then xs else (x#del1 a xs))"
   7.339 -
   7.340 -lemma "Suc (occurs a (del1 a xs)) = occurs a xs"
   7.341 -  -- {* Wrong. Precondition needed.*}
   7.342 -  quickcheck [generator = code]
   7.343 -  oops
   7.344 -
   7.345 -lemma "xs ~= [] \<longrightarrow> Suc (occurs a (del1 a xs)) = occurs a xs"
   7.346 -  quickcheck [generator = code]
   7.347 -    -- {* Also wrong.*}
   7.348 -  oops
   7.349 -
   7.350 -lemma "0 < occurs a xs \<longrightarrow> Suc (occurs a (del1 a xs)) = occurs a xs"
   7.351 -  quickcheck [generator = code]
   7.352 -  by (induct xs) auto
   7.353 -
   7.354 -primrec replace :: "'a \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   7.355 -  "replace a b [] = []"
   7.356 -  | "replace a b (x#xs) = (if (x=a) then (b#(replace a b xs)) 
   7.357 -                            else (x#(replace a b xs)))"
   7.358 -
   7.359 -lemma "occurs a xs = occurs b (replace a b xs)"
   7.360 -  quickcheck [generator = code]
   7.361 -  -- {* Wrong. Precondition needed.*}
   7.362 -  oops
   7.363 -
   7.364 -lemma "occurs b xs = 0 \<or> a=b \<longrightarrow> occurs a xs = occurs b (replace a b xs)"
   7.365 -  quickcheck [generator = code]
   7.366 -  by (induct xs) simp_all
   7.367 -
   7.368 -
   7.369 -subsection {* Trees *}
   7.370 -
   7.371 -datatype 'a tree = Twig |  Leaf 'a | Branch "'a tree" "'a tree"
   7.372 -
   7.373 -primrec leaves :: "'a tree \<Rightarrow> 'a list" where
   7.374 -  "leaves Twig = []"
   7.375 -  | "leaves (Leaf a) = [a]"
   7.376 -  | "leaves (Branch l r) = (leaves l) @ (leaves r)"
   7.377 -
   7.378 -primrec plant :: "'a list \<Rightarrow> 'a tree" where
   7.379 -  "plant [] = Twig "
   7.380 -  | "plant (x#xs) = Branch (Leaf x) (plant xs)"
   7.381 -
   7.382 -primrec mirror :: "'a tree \<Rightarrow> 'a tree" where
   7.383 -  "mirror (Twig) = Twig "
   7.384 -  | "mirror (Leaf a) = Leaf a "
   7.385 -  | "mirror (Branch l r) = Branch (mirror r) (mirror l)"
   7.386 -
   7.387 -theorem "plant (rev (leaves xt)) = mirror xt"
   7.388 -  quickcheck [generator = code]
   7.389 -    --{* Wrong! *} 
   7.390 -  oops
   7.391 -
   7.392 -theorem "plant (leaves xt @ leaves yt) = Branch xt yt"
   7.393 -  quickcheck [generator = code]
   7.394 -    --{* Wrong! *} 
   7.395 -  oops
   7.396 -
   7.397 -datatype 'a ntree = Tip "'a" | Node "'a" "'a ntree" "'a ntree"
   7.398 -
   7.399 -primrec inOrder :: "'a ntree \<Rightarrow> 'a list" where
   7.400 -  "inOrder (Tip a)= [a]"
   7.401 -  | "inOrder (Node f x y) = (inOrder x)@[f]@(inOrder y)"
   7.402 -
   7.403 -primrec root :: "'a ntree \<Rightarrow> 'a" where
   7.404 -  "root (Tip a) = a"
   7.405 -  | "root (Node f x y) = f"
   7.406 -
   7.407 -theorem "hd (inOrder xt) = root xt"
   7.408 -  quickcheck [generator = code]
   7.409 -    --{* Wrong! *} 
   7.410 -  oops
   7.411 -
   7.412 -lemma "int (f k) = k"
   7.413 -  quickcheck [generator = code]
   7.414 -  oops
   7.415 -
   7.416 -end
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/HOL/ex/Quickcheck_Generators.thy	Thu Feb 05 14:50:43 2009 +0100
     8.3 @@ -0,0 +1,353 @@
     8.4 +(* Author: Florian Haftmann, TU Muenchen *)
     8.5 +
     8.6 +header {* Experimental counterexample generators *}
     8.7 +
     8.8 +theory Quickcheck_Generators
     8.9 +imports Quickcheck State_Monad
    8.10 +begin
    8.11 +
    8.12 +subsection {* Type @{typ "'a \<Rightarrow> 'b"} *}
    8.13 +
    8.14 +ML {*
    8.15 +structure Random_Engine =
    8.16 +struct
    8.17 +
    8.18 +open Random_Engine;
    8.19 +
    8.20 +fun random_fun (T1 : typ) (T2 : typ) (eq : 'a -> 'a -> bool) (term_of : 'a -> term)
    8.21 +    (random : Random_Engine.seed -> ('b * (unit -> term)) * Random_Engine.seed)
    8.22 +    (random_split : Random_Engine.seed -> Random_Engine.seed * Random_Engine.seed)
    8.23 +    (seed : Random_Engine.seed) =
    8.24 +  let
    8.25 +    val (seed', seed'') = random_split seed;
    8.26 +    val state = ref (seed', [], Const (@{const_name undefined}, T1 --> T2));
    8.27 +    val fun_upd = Const (@{const_name fun_upd},
    8.28 +      (T1 --> T2) --> T1 --> T2 --> T1 --> T2);
    8.29 +    fun random_fun' x =
    8.30 +      let
    8.31 +        val (seed, fun_map, f_t) = ! state;
    8.32 +      in case AList.lookup (uncurry eq) fun_map x
    8.33 +       of SOME y => y
    8.34 +        | NONE => let
    8.35 +              val t1 = term_of x;
    8.36 +              val ((y, t2), seed') = random seed;
    8.37 +              val fun_map' = (x, y) :: fun_map;
    8.38 +              val f_t' = fun_upd $ f_t $ t1 $ t2 ();
    8.39 +              val _ = state := (seed', fun_map', f_t');
    8.40 +            in y end
    8.41 +      end;
    8.42 +    fun term_fun' () = #3 (! state);
    8.43 +  in ((random_fun', term_fun'), seed'') end;
    8.44 +
    8.45 +end
    8.46 +*}
    8.47 +
    8.48 +axiomatization
    8.49 +  random_fun_aux :: "typerep \<Rightarrow> typerep \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> term)
    8.50 +    \<Rightarrow> (seed \<Rightarrow> ('b \<times> (unit \<Rightarrow> term)) \<times> seed) \<Rightarrow> (seed \<Rightarrow> seed \<times> seed)
    8.51 +    \<Rightarrow> seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> seed"
    8.52 +
    8.53 +code_const random_fun_aux (SML "Random'_Engine.random'_fun")
    8.54 +
    8.55 +instantiation "fun" :: ("{eq, term_of}", "{type, random}") random
    8.56 +begin
    8.57 +
    8.58 +definition random_fun :: "index \<Rightarrow> seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> seed" where
    8.59 +  "random n = random_fun_aux TYPEREP('a) TYPEREP('b) (op =) Code_Eval.term_of (random n) split_seed"
    8.60 +
    8.61 +instance ..
    8.62 +
    8.63 +end
    8.64 +
    8.65 +code_reserved SML Random_Engine
    8.66 +
    8.67 +
    8.68 +subsection {* Datatypes *}
    8.69 +
    8.70 +definition
    8.71 +  collapse :: "('a \<Rightarrow> ('a \<Rightarrow> 'b \<times> 'a) \<times> 'a) \<Rightarrow> 'a \<Rightarrow> 'b \<times> 'a" where
    8.72 +  "collapse f = (do g \<leftarrow> f; g done)"
    8.73 +
    8.74 +ML {*
    8.75 +structure StateMonad =
    8.76 +struct
    8.77 +
    8.78 +fun liftT T sT = sT --> HOLogic.mk_prodT (T, sT);
    8.79 +fun liftT' sT = sT --> sT;
    8.80 +
    8.81 +fun return T sT x = Const (@{const_name return}, T --> liftT T sT) $ x;
    8.82 +
    8.83 +fun scomp T1 T2 sT f g = Const (@{const_name scomp},
    8.84 +  liftT T1 sT --> (T1 --> liftT T2 sT) --> liftT T2 sT) $ f $ g;
    8.85 +
    8.86 +end;
    8.87 +*}
    8.88 +
    8.89 +lemma random'_if:
    8.90 +  fixes random' :: "index \<Rightarrow> index \<Rightarrow> seed \<Rightarrow> ('a \<times> (unit \<Rightarrow> term)) \<times> seed"
    8.91 +  assumes "random' 0 j = (\<lambda>s. undefined)"
    8.92 +    and "\<And>i. random' (Suc_index i) j = rhs2 i"
    8.93 +  shows "random' i j s = (if i = 0 then undefined else rhs2 (i - 1) s)"
    8.94 +  by (cases i rule: index.exhaust) (insert assms, simp_all)
    8.95 +
    8.96 +setup {*
    8.97 +let
    8.98 +  exception REC of string;
    8.99 +  exception TYP of string;
   8.100 +  fun mk_collapse thy ty = Sign.mk_const thy
   8.101 +    (@{const_name collapse}, [@{typ seed}, ty]);
   8.102 +  fun term_ty ty = HOLogic.mk_prodT (ty, @{typ "unit \<Rightarrow> term"});
   8.103 +  fun mk_split thy ty ty' = Sign.mk_const thy
   8.104 +    (@{const_name split}, [ty, @{typ "unit \<Rightarrow> term"}, StateMonad.liftT (term_ty ty') @{typ seed}]);
   8.105 +  fun mk_scomp_split thy ty ty' t t' =
   8.106 +    StateMonad.scomp (term_ty ty) (term_ty ty') @{typ seed} t
   8.107 +      (mk_split thy ty ty' $ Abs ("", ty, Abs ("", @{typ "unit \<Rightarrow> term"}, t')))
   8.108 +  fun mk_cons thy this_ty (c, args) =
   8.109 +    let
   8.110 +      val tys = map (fst o fst) args;
   8.111 +      val c_ty = tys ---> this_ty;
   8.112 +      val c = Const (c, tys ---> this_ty);
   8.113 +      val t_indices = map (curry ( op * ) 2) (length tys - 1 downto 0);
   8.114 +      val c_indices = map (curry ( op + ) 1) t_indices;
   8.115 +      val c_t = list_comb (c, map Bound c_indices);
   8.116 +      val t_t = Abs ("", @{typ unit}, Eval.mk_term Free Typerep.typerep
   8.117 +        (list_comb (c, map (fn k => Bound (k + 1)) t_indices))
   8.118 +        |> map_aterms (fn t as Bound _ => t $ @{term "()"} | t => t));
   8.119 +      val return = StateMonad.return (term_ty this_ty) @{typ seed}
   8.120 +        (HOLogic.mk_prod (c_t, t_t));
   8.121 +      val t = fold_rev (fn ((ty, _), random) =>
   8.122 +        mk_scomp_split thy ty this_ty random)
   8.123 +          args return;
   8.124 +      val is_rec = exists (snd o fst) args;
   8.125 +    in (is_rec, t) end;
   8.126 +  fun mk_conss thy ty [] = NONE
   8.127 +    | mk_conss thy ty [(_, t)] = SOME t
   8.128 +    | mk_conss thy ty ts = SOME (mk_collapse thy (term_ty ty) $
   8.129 +          (Sign.mk_const thy (@{const_name select}, [StateMonad.liftT (term_ty ty) @{typ seed}]) $
   8.130 +            HOLogic.mk_list (StateMonad.liftT (term_ty ty) @{typ seed}) (map snd ts)));
   8.131 +  fun mk_clauses thy ty (tyco, (ts_rec, ts_atom)) = 
   8.132 +    let
   8.133 +      val SOME t_atom = mk_conss thy ty ts_atom;
   8.134 +    in case mk_conss thy ty ts_rec
   8.135 +     of SOME t_rec => mk_collapse thy (term_ty ty) $
   8.136 +          (Sign.mk_const thy (@{const_name select_default}, [StateMonad.liftT (term_ty ty) @{typ seed}]) $
   8.137 +             @{term "i\<Colon>index"} $ t_rec $ t_atom)
   8.138 +      | NONE => t_atom
   8.139 +    end;
   8.140 +  fun mk_random_eqs thy vs tycos =
   8.141 +    let
   8.142 +      val this_ty = Type (hd tycos, map TFree vs);
   8.143 +      val this_ty' = StateMonad.liftT (term_ty this_ty) @{typ seed};
   8.144 +      val random_name = NameSpace.base @{const_name random};
   8.145 +      val random'_name = random_name ^ "_" ^ Class.type_name (hd tycos) ^ "'";
   8.146 +      fun random ty = Sign.mk_const thy (@{const_name random}, [ty]);
   8.147 +      val random' = Free (random'_name,
   8.148 +        @{typ index} --> @{typ index} --> this_ty');
   8.149 +      fun atom ty = if Sign.of_sort thy (ty, @{sort random})
   8.150 +        then ((ty, false), random ty $ @{term "j\<Colon>index"})
   8.151 +        else raise TYP
   8.152 +          ("Will not generate random elements for type(s) " ^ quote (hd tycos));
   8.153 +      fun dtyp tyco = ((this_ty, true), random' $ @{term "i\<Colon>index"} $ @{term "j\<Colon>index"});
   8.154 +      fun rtyp tyco tys = raise REC
   8.155 +        ("Will not generate random elements for mutual recursive type " ^ quote (hd tycos));
   8.156 +      val rhss = DatatypePackage.construction_interpretation thy
   8.157 +            { atom = atom, dtyp = dtyp, rtyp = rtyp } vs tycos
   8.158 +        |> (map o apsnd o map) (mk_cons thy this_ty) 
   8.159 +        |> (map o apsnd) (List.partition fst)
   8.160 +        |> map (mk_clauses thy this_ty)
   8.161 +      val eqss = map ((apsnd o map) (HOLogic.mk_Trueprop o HOLogic.mk_eq) o (fn rhs => ((this_ty, random'), [
   8.162 +          (random' $ @{term "0\<Colon>index"} $ @{term "j\<Colon>index"}, Abs ("s", @{typ seed},
   8.163 +            Const (@{const_name undefined}, HOLogic.mk_prodT (term_ty this_ty, @{typ seed})))),
   8.164 +          (random' $ @{term "Suc_index i"} $ @{term "j\<Colon>index"}, rhs)
   8.165 +        ]))) rhss;
   8.166 +    in eqss end;
   8.167 +  fun random_inst [tyco] thy =
   8.168 +        let
   8.169 +          val (raw_vs, _) = DatatypePackage.the_datatype_spec thy tyco;
   8.170 +          val vs = (map o apsnd)
   8.171 +            (curry (Sorts.inter_sort (Sign.classes_of thy)) @{sort random}) raw_vs;
   8.172 +          val ((this_ty, random'), eqs') = singleton (mk_random_eqs thy vs) tyco;
   8.173 +          val eq = (HOLogic.mk_Trueprop o HOLogic.mk_eq)
   8.174 +            (Sign.mk_const thy (@{const_name random}, [this_ty]) $ @{term "i\<Colon>index"},
   8.175 +               random' $ @{term "i\<Colon>index"} $ @{term "i\<Colon>index"})
   8.176 +          val del_func = Attrib.internal (fn _ => Thm.declaration_attribute
   8.177 +            (fn thm => Context.mapping (Code.del_eqn thm) I));
   8.178 +          fun add_code simps lthy =
   8.179 +            let
   8.180 +              val thy = ProofContext.theory_of lthy;
   8.181 +              val thm = @{thm random'_if}
   8.182 +                |> Drule.instantiate' [SOME (Thm.ctyp_of thy this_ty)] [SOME (Thm.cterm_of thy random')]
   8.183 +                |> (fn thm => thm OF simps)
   8.184 +                |> singleton (ProofContext.export lthy (ProofContext.init thy));
   8.185 +              val c = (fst o dest_Const o fst o strip_comb o fst
   8.186 +                o HOLogic.dest_eq o HOLogic.dest_Trueprop o Thm.prop_of) thm;
   8.187 +            in
   8.188 +              lthy
   8.189 +              |> LocalTheory.theory (Code.del_eqns c
   8.190 +                   #> PureThy.add_thm ((Binding.name (fst (dest_Free random') ^ "_code"), thm), [Thm.kind_internal])
   8.191 +                   #-> Code.add_eqn)
   8.192 +            end;
   8.193 +        in
   8.194 +          thy
   8.195 +          |> TheoryTarget.instantiation ([tyco], vs, @{sort random})
   8.196 +          |> PrimrecPackage.add_primrec
   8.197 +               [(Binding.name (fst (dest_Free random')), SOME (snd (dest_Free random')), NoSyn)]
   8.198 +                 (map (fn eq => ((Binding.empty, [del_func]), eq)) eqs')
   8.199 +          |-> add_code
   8.200 +          |> `(fn lthy => Syntax.check_term lthy eq)
   8.201 +          |-> (fn eq => Specification.definition (NONE, (Attrib.empty_binding, eq)))
   8.202 +          |> snd
   8.203 +          |> Class.prove_instantiation_instance (K (Class.intro_classes_tac []))
   8.204 +          |> LocalTheory.exit_global
   8.205 +        end
   8.206 +    | random_inst tycos thy = raise REC
   8.207 +        ("Will not generate random elements for mutual recursive type(s) " ^ commas (map quote tycos));
   8.208 +  fun add_random_inst tycos thy = random_inst tycos thy
   8.209 +     handle REC msg => (warning msg; thy)
   8.210 +          | TYP msg => (warning msg; thy)
   8.211 +in DatatypePackage.interpretation add_random_inst end
   8.212 +*}
   8.213 +
   8.214 +
   8.215 +subsection {* Type @{typ int} *}
   8.216 +
   8.217 +instantiation int :: random
   8.218 +begin
   8.219 +
   8.220 +definition
   8.221 +  "random n = (do
   8.222 +     (b, _) \<leftarrow> random n;
   8.223 +     (m, t) \<leftarrow> random n;
   8.224 +     return (if b then (int m, \<lambda>u. Code_Eval.App (Code_Eval.Const (STR ''Int.int'') TYPEREP(nat \<Rightarrow> int)) (t ()))
   8.225 +       else (- int m, \<lambda>u. Code_Eval.App (Code_Eval.Const (STR ''HOL.uminus_class.uminus'') TYPEREP(int \<Rightarrow> int))
   8.226 +         (Code_Eval.App (Code_Eval.Const (STR ''Int.int'') TYPEREP(nat \<Rightarrow> int)) (t ()))))
   8.227 +   done)"
   8.228 +
   8.229 +instance ..
   8.230 +
   8.231 +end
   8.232 +
   8.233 +
   8.234 +subsection {* Examples *}
   8.235 +
   8.236 +theorem "map g (map f xs) = map (g o f) xs"
   8.237 +  quickcheck [generator = code]
   8.238 +  by (induct xs) simp_all
   8.239 +
   8.240 +theorem "map g (map f xs) = map (f o g) xs"
   8.241 +  quickcheck [generator = code]
   8.242 +  oops
   8.243 +
   8.244 +theorem "rev (xs @ ys) = rev ys @ rev xs"
   8.245 +  quickcheck [generator = code]
   8.246 +  by simp
   8.247 +
   8.248 +theorem "rev (xs @ ys) = rev xs @ rev ys"
   8.249 +  quickcheck [generator = code]
   8.250 +  oops
   8.251 +
   8.252 +theorem "rev (rev xs) = xs"
   8.253 +  quickcheck [generator = code]
   8.254 +  by simp
   8.255 +
   8.256 +theorem "rev xs = xs"
   8.257 +  quickcheck [generator = code]
   8.258 +  oops
   8.259 +
   8.260 +primrec app :: "('a \<Rightarrow> 'a) list \<Rightarrow> 'a \<Rightarrow> 'a" where
   8.261 +  "app [] x = x"
   8.262 +  | "app (f # fs) x = app fs (f x)"
   8.263 +
   8.264 +lemma "app (fs @ gs) x = app gs (app fs x)"
   8.265 +  quickcheck [generator = code]
   8.266 +  by (induct fs arbitrary: x) simp_all
   8.267 +
   8.268 +lemma "app (fs @ gs) x = app fs (app gs x)"
   8.269 +  quickcheck [generator = code]
   8.270 +  oops
   8.271 +
   8.272 +primrec occurs :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
   8.273 +  "occurs a [] = 0"
   8.274 +  | "occurs a (x#xs) = (if (x=a) then Suc(occurs a xs) else occurs a xs)"
   8.275 +
   8.276 +primrec del1 :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   8.277 +  "del1 a [] = []"
   8.278 +  | "del1 a (x#xs) = (if (x=a) then xs else (x#del1 a xs))"
   8.279 +
   8.280 +lemma "Suc (occurs a (del1 a xs)) = occurs a xs"
   8.281 +  -- {* Wrong. Precondition needed.*}
   8.282 +  quickcheck [generator = code]
   8.283 +  oops
   8.284 +
   8.285 +lemma "xs ~= [] \<longrightarrow> Suc (occurs a (del1 a xs)) = occurs a xs"
   8.286 +  quickcheck [generator = code]
   8.287 +    -- {* Also wrong.*}
   8.288 +  oops
   8.289 +
   8.290 +lemma "0 < occurs a xs \<longrightarrow> Suc (occurs a (del1 a xs)) = occurs a xs"
   8.291 +  quickcheck [generator = code]
   8.292 +  by (induct xs) auto
   8.293 +
   8.294 +primrec replace :: "'a \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   8.295 +  "replace a b [] = []"
   8.296 +  | "replace a b (x#xs) = (if (x=a) then (b#(replace a b xs)) 
   8.297 +                            else (x#(replace a b xs)))"
   8.298 +
   8.299 +lemma "occurs a xs = occurs b (replace a b xs)"
   8.300 +  quickcheck [generator = code]
   8.301 +  -- {* Wrong. Precondition needed.*}
   8.302 +  oops
   8.303 +
   8.304 +lemma "occurs b xs = 0 \<or> a=b \<longrightarrow> occurs a xs = occurs b (replace a b xs)"
   8.305 +  quickcheck [generator = code]
   8.306 +  by (induct xs) simp_all
   8.307 +
   8.308 +
   8.309 +subsection {* Trees *}
   8.310 +
   8.311 +datatype 'a tree = Twig |  Leaf 'a | Branch "'a tree" "'a tree"
   8.312 +
   8.313 +primrec leaves :: "'a tree \<Rightarrow> 'a list" where
   8.314 +  "leaves Twig = []"
   8.315 +  | "leaves (Leaf a) = [a]"
   8.316 +  | "leaves (Branch l r) = (leaves l) @ (leaves r)"
   8.317 +
   8.318 +primrec plant :: "'a list \<Rightarrow> 'a tree" where
   8.319 +  "plant [] = Twig "
   8.320 +  | "plant (x#xs) = Branch (Leaf x) (plant xs)"
   8.321 +
   8.322 +primrec mirror :: "'a tree \<Rightarrow> 'a tree" where
   8.323 +  "mirror (Twig) = Twig "
   8.324 +  | "mirror (Leaf a) = Leaf a "
   8.325 +  | "mirror (Branch l r) = Branch (mirror r) (mirror l)"
   8.326 +
   8.327 +theorem "plant (rev (leaves xt)) = mirror xt"
   8.328 +  quickcheck [generator = code]
   8.329 +    --{* Wrong! *} 
   8.330 +  oops
   8.331 +
   8.332 +theorem "plant (leaves xt @ leaves yt) = Branch xt yt"
   8.333 +  quickcheck [generator = code]
   8.334 +    --{* Wrong! *} 
   8.335 +  oops
   8.336 +
   8.337 +datatype 'a ntree = Tip "'a" | Node "'a" "'a ntree" "'a ntree"
   8.338 +
   8.339 +primrec inOrder :: "'a ntree \<Rightarrow> 'a list" where
   8.340 +  "inOrder (Tip a)= [a]"
   8.341 +  | "inOrder (Node f x y) = (inOrder x)@[f]@(inOrder y)"
   8.342 +
   8.343 +primrec root :: "'a ntree \<Rightarrow> 'a" where
   8.344 +  "root (Tip a) = a"
   8.345 +  | "root (Node f x y) = f"
   8.346 +
   8.347 +theorem "hd (inOrder xt) = root xt"
   8.348 +  quickcheck [generator = code]
   8.349 +    --{* Wrong! *} 
   8.350 +  oops
   8.351 +
   8.352 +lemma "int (f k) = k"
   8.353 +  quickcheck [generator = code]
   8.354 +  oops
   8.355 +
   8.356 +end
     9.1 --- a/src/HOL/ex/ROOT.ML	Thu Feb 05 11:49:15 2009 +0100
     9.2 +++ b/src/HOL/ex/ROOT.ML	Thu Feb 05 14:50:43 2009 +0100
     9.3 @@ -10,7 +10,7 @@
     9.4    "FuncSet",
     9.5    "Word",
     9.6    "Eval_Examples",
     9.7 -  "Quickcheck",
     9.8 +  "Quickcheck_Generators",
     9.9    "Term_Of_Syntax",
    9.10    "Codegenerator",
    9.11    "Codegenerator_Pretty",
    10.1 --- a/src/HOL/ex/Random.thy	Thu Feb 05 11:49:15 2009 +0100
    10.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.3 @@ -1,183 +0,0 @@
    10.4 -(*  ID:         $Id$
    10.5 -    Author:     Florian Haftmann, TU Muenchen
    10.6 -*)
    10.7 -
    10.8 -header {* A HOL random engine *}
    10.9 -
   10.10 -theory Random
   10.11 -imports State_Monad Code_Index
   10.12 -begin
   10.13 -
   10.14 -subsection {* Auxiliary functions *}
   10.15 -
   10.16 -definition
   10.17 -  inc_shift :: "index \<Rightarrow> index \<Rightarrow> index"
   10.18 -where
   10.19 -  "inc_shift v k = (if v = k then 1 else k + 1)"
   10.20 -
   10.21 -definition
   10.22 -  minus_shift :: "index \<Rightarrow> index \<Rightarrow> index \<Rightarrow> index"
   10.23 -where
   10.24 -  "minus_shift r k l = (if k < l then r + k - l else k - l)"
   10.25 -
   10.26 -fun
   10.27 -  log :: "index \<Rightarrow> index \<Rightarrow> index"
   10.28 -where
   10.29 -  "log b i = (if b \<le> 1 \<or> i < b then 1 else 1 + log b (i div b))"
   10.30 -
   10.31 -subsection {* Random seeds *}
   10.32 -
   10.33 -types seed = "index \<times> index"
   10.34 -
   10.35 -primrec
   10.36 -  "next" :: "seed \<Rightarrow> index \<times> seed"
   10.37 -where
   10.38 -  "next (v, w) = (let
   10.39 -     k =  v div 53668;
   10.40 -     v' = minus_shift 2147483563 (40014 * (v mod 53668)) (k * 12211);
   10.41 -     l =  w div 52774;
   10.42 -     w' = minus_shift 2147483399 (40692 * (w mod 52774)) (l * 3791);
   10.43 -     z =  minus_shift 2147483562 v' (w' + 1) + 1
   10.44 -   in (z, (v', w')))"
   10.45 -
   10.46 -lemma next_not_0:
   10.47 -  "fst (next s) \<noteq> 0"
   10.48 -apply (cases s)
   10.49 -apply (auto simp add: minus_shift_def Let_def)
   10.50 -done
   10.51 -
   10.52 -primrec
   10.53 -  seed_invariant :: "seed \<Rightarrow> bool"
   10.54 -where
   10.55 -  "seed_invariant (v, w) \<longleftrightarrow> 0 < v \<and> v < 9438322952 \<and> 0 < w \<and> True"
   10.56 -
   10.57 -lemma if_same:
   10.58 -  "(if b then f x else f y) = f (if b then x else y)"
   10.59 -  by (cases b) simp_all
   10.60 -
   10.61 -definition
   10.62 -  split_seed :: "seed \<Rightarrow> seed \<times> seed"
   10.63 -where
   10.64 -  "split_seed s = (let
   10.65 -     (v, w) = s;
   10.66 -     (v', w') = snd (next s);
   10.67 -     v'' = inc_shift 2147483562 v;
   10.68 -     s'' = (v'', w');
   10.69 -     w'' = inc_shift 2147483398 w;
   10.70 -     s''' = (v', w'')
   10.71 -   in (s'', s'''))"
   10.72 -
   10.73 -
   10.74 -subsection {* Base selectors *}
   10.75 -
   10.76 -function
   10.77 -  range_aux :: "index \<Rightarrow> index \<Rightarrow> seed \<Rightarrow> index \<times> seed"
   10.78 -where
   10.79 -  "range_aux k l s = (if k = 0 then (l, s) else
   10.80 -    let (v, s') = next s
   10.81 -  in range_aux (k - 1) (v + l * 2147483561) s')"
   10.82 -by pat_completeness auto
   10.83 -termination
   10.84 -  by (relation "measure (nat_of_index o fst)")
   10.85 -    (auto simp add: index)
   10.86 -
   10.87 -definition
   10.88 -  range :: "index \<Rightarrow> seed \<Rightarrow> index \<times> seed"
   10.89 -where
   10.90 -  "range k = (do
   10.91 -     v \<leftarrow> range_aux (log 2147483561 k) 1;
   10.92 -     return (v mod k)
   10.93 -   done)"
   10.94 -
   10.95 -lemma range:
   10.96 -  assumes "k > 0"
   10.97 -  shows "fst (range k s) < k"
   10.98 -proof -
   10.99 -  obtain v w where range_aux:
  10.100 -    "range_aux (log 2147483561 k) 1 s = (v, w)"
  10.101 -    by (cases "range_aux (log 2147483561 k) 1 s")
  10.102 -  with assms show ?thesis
  10.103 -    by (simp add: monad_collapse range_def del: range_aux.simps log.simps)
  10.104 -qed
  10.105 -
  10.106 -definition
  10.107 -  select :: "'a list \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
  10.108 -where
  10.109 -  "select xs = (do
  10.110 -     k \<leftarrow> range (index_of_nat (length xs));
  10.111 -     return (nth xs (nat_of_index k))
  10.112 -   done)"
  10.113 -
  10.114 -lemma select:
  10.115 -  assumes "xs \<noteq> []"
  10.116 -  shows "fst (select xs s) \<in> set xs"
  10.117 -proof -
  10.118 -  from assms have "index_of_nat (length xs) > 0" by simp
  10.119 -  with range have
  10.120 -    "fst (range (index_of_nat (length xs)) s) < index_of_nat (length xs)" by best
  10.121 -  then have
  10.122 -    "nat_of_index (fst (range (index_of_nat (length xs)) s)) < length xs" by simp
  10.123 -  then show ?thesis
  10.124 -    by (auto simp add: monad_collapse select_def)
  10.125 -qed
  10.126 -
  10.127 -definition
  10.128 -  select_default :: "index \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> seed \<Rightarrow> 'a \<times> seed"
  10.129 -where
  10.130 -  [code del]: "select_default k x y = (do
  10.131 -     l \<leftarrow> range k;
  10.132 -     return (if l + 1 < k then x else y)
  10.133 -   done)"
  10.134 -
  10.135 -lemma select_default_zero:
  10.136 -  "fst (select_default 0 x y s) = y"
  10.137 -  by (simp add: monad_collapse select_default_def)
  10.138 -
  10.139 -lemma select_default_code [code]:
  10.140 -  "select_default k x y = (if k = 0 then do
  10.141 -     _ \<leftarrow> range 1;
  10.142 -     return y
  10.143 -   done else do
  10.144 -     l \<leftarrow> range k;
  10.145 -     return (if l + 1 < k then x else y)
  10.146 -   done)"
  10.147 -proof (cases "k = 0")
  10.148 -  case False then show ?thesis by (simp add: select_default_def)
  10.149 -next
  10.150 -  case True then show ?thesis
  10.151 -    by (simp add: monad_collapse select_default_def range_def)
  10.152 -qed
  10.153 -
  10.154 -
  10.155 -subsection {* @{text ML} interface *}
  10.156 -
  10.157 -ML {*
  10.158 -structure Random_Engine =
  10.159 -struct
  10.160 -
  10.161 -type seed = int * int;
  10.162 -
  10.163 -local
  10.164 -
  10.165 -val seed = ref 
  10.166 -  (let
  10.167 -    val now = Time.toMilliseconds (Time.now ());
  10.168 -    val (q, s1) = IntInf.divMod (now, 2147483562);
  10.169 -    val s2 = q mod 2147483398;
  10.170 -  in (s1 + 1, s2 + 1) end);
  10.171 -
  10.172 -in
  10.173 -
  10.174 -fun run f =
  10.175 -  let
  10.176 -    val (x, seed') = f (! seed);
  10.177 -    val _ = seed := seed'
  10.178 -  in x end;
  10.179 -
  10.180 -end;
  10.181 -
  10.182 -end;
  10.183 -*}
  10.184 -
  10.185 -end
  10.186 -