6 *) |
6 *) |
7 |
7 |
8 header {* Nitpick: Yet Another Counterexample Generator for Isabelle/HOL *} |
8 header {* Nitpick: Yet Another Counterexample Generator for Isabelle/HOL *} |
9 |
9 |
10 theory Nitpick |
10 theory Nitpick |
11 imports Map SAT |
11 imports Map Quickcheck SAT |
12 uses ("Tools/Nitpick/kodkod.ML") |
12 uses ("Tools/Nitpick/kodkod.ML") |
13 ("Tools/Nitpick/kodkod_sat.ML") |
13 ("Tools/Nitpick/kodkod_sat.ML") |
14 ("Tools/Nitpick/nitpick_util.ML") |
14 ("Tools/Nitpick/nitpick_util.ML") |
15 ("Tools/Nitpick/nitpick_hol.ML") |
15 ("Tools/Nitpick/nitpick_hol.ML") |
16 ("Tools/Nitpick/nitpick_mono.ML") |
16 ("Tools/Nitpick/nitpick_mono.ML") |
115 "unit_case x u \<equiv> x" |
115 "unit_case x u \<equiv> x" |
116 apply (subgoal_tac "u = ()") |
116 apply (subgoal_tac "u = ()") |
117 apply (simp only: unit.cases) |
117 apply (simp only: unit.cases) |
118 by simp |
118 by simp |
119 |
119 |
|
120 declare unit.cases [nitpick_simp del] |
|
121 |
120 lemma nat_case_def [nitpick_def]: |
122 lemma nat_case_def [nitpick_def]: |
121 "nat_case x f n \<equiv> if n = 0 then x else f (n - 1)" |
123 "nat_case x f n \<equiv> if n = 0 then x else f (n - 1)" |
122 apply (rule eq_reflection) |
124 apply (rule eq_reflection) |
123 by (case_tac n) auto |
125 by (case_tac n) auto |
124 |
126 |
125 lemmas dvd_def = dvd_eq_mod_eq_0 [THEN eq_reflection, nitpick_def] |
127 declare nat.cases [nitpick_simp del] |
|
128 |
|
129 lemmas [nitpick_def] = dvd_eq_mod_eq_0 [THEN eq_reflection] |
126 |
130 |
127 lemma list_size_simp [nitpick_simp]: |
131 lemma list_size_simp [nitpick_simp]: |
128 "list_size f xs = (if xs = [] then 0 |
132 "list_size f xs = (if xs = [] then 0 |
129 else Suc (f (hd xs) + list_size f (tl xs)))" |
133 else Suc (f (hd xs) + list_size f (tl xs)))" |
130 "size xs = (if xs = [] then 0 else Suc (size (tl xs)))" |
134 "size xs = (if xs = [] then 0 else Suc (size (tl xs)))" |
203 [nitpick_simp]: |
207 [nitpick_simp]: |
204 "less_eq_frac q r \<longleftrightarrow> num (plus_frac q (uminus_frac r)) \<le> 0" |
208 "less_eq_frac q r \<longleftrightarrow> num (plus_frac q (uminus_frac r)) \<le> 0" |
205 |
209 |
206 definition of_frac :: "'a \<Rightarrow> 'b\<Colon>{inverse,ring_1}" where |
210 definition of_frac :: "'a \<Rightarrow> 'b\<Colon>{inverse,ring_1}" where |
207 "of_frac q \<equiv> of_int (num q) / of_int (denom q)" |
211 "of_frac q \<equiv> of_int (num q) / of_int (denom q)" |
|
212 |
|
213 (* While Nitpick normally avoids to unfold definitions for locales, it |
|
214 unfortunately needs to unfold them when dealing with the following built-in |
|
215 constants. A cleaner approach would be to change "Nitpick_HOL" and |
|
216 "Nitpick_Nits" so that they handle the unexpanded overloaded constants |
|
217 directly, but this is slightly more tricky to implement. *) |
|
218 lemmas [nitpick_def] = div_int_inst.div_int div_int_inst.mod_int |
|
219 div_nat_inst.div_nat div_nat_inst.mod_nat lower_semilattice_fun_inst.inf_fun |
|
220 minus_fun_inst.minus_fun minus_int_inst.minus_int minus_nat_inst.minus_nat |
|
221 one_int_inst.one_int one_nat_inst.one_nat ord_fun_inst.less_eq_fun |
|
222 ord_int_inst.less_eq_int ord_int_inst.less_int ord_nat_inst.less_eq_nat |
|
223 ord_nat_inst.less_nat plus_int_inst.plus_int plus_nat_inst.plus_nat |
|
224 times_int_inst.times_int times_nat_inst.times_nat uminus_int_inst.uminus_int |
|
225 upper_semilattice_fun_inst.sup_fun zero_int_inst.zero_int |
|
226 zero_nat_inst.zero_nat |
208 |
227 |
209 use "Tools/Nitpick/kodkod.ML" |
228 use "Tools/Nitpick/kodkod.ML" |
210 use "Tools/Nitpick/kodkod_sat.ML" |
229 use "Tools/Nitpick/kodkod_sat.ML" |
211 use "Tools/Nitpick/nitpick_util.ML" |
230 use "Tools/Nitpick/nitpick_util.ML" |
212 use "Tools/Nitpick/nitpick_hol.ML" |
231 use "Tools/Nitpick/nitpick_hol.ML" |
220 use "Tools/Nitpick/nitpick.ML" |
239 use "Tools/Nitpick/nitpick.ML" |
221 use "Tools/Nitpick/nitpick_isar.ML" |
240 use "Tools/Nitpick/nitpick_isar.ML" |
222 use "Tools/Nitpick/nitpick_tests.ML" |
241 use "Tools/Nitpick/nitpick_tests.ML" |
223 use "Tools/Nitpick/minipick.ML" |
242 use "Tools/Nitpick/minipick.ML" |
224 |
243 |
|
244 setup {* Nitpick_Isar.setup *} |
|
245 |
225 hide (open) const unknown undefined_fast_The undefined_fast_Eps bisim |
246 hide (open) const unknown undefined_fast_The undefined_fast_Eps bisim |
226 bisim_iterator_max Tha refl' wf' wf_wfrec wf_wfrec' wfrec' card' setsum' |
247 bisim_iterator_max Tha refl' wf' wf_wfrec wf_wfrec' wfrec' card' setsum' |
227 fold_graph' nat_gcd nat_lcm int_gcd int_lcm Frac Abs_Frac Rep_Frac zero_frac |
248 fold_graph' nat_gcd nat_lcm int_gcd int_lcm Frac Abs_Frac Rep_Frac zero_frac |
228 one_frac num denom norm_frac frac plus_frac times_frac uminus_frac |
249 one_frac num denom norm_frac frac plus_frac times_frac uminus_frac |
229 number_of_frac inverse_frac less_eq_frac of_frac |
250 number_of_frac inverse_frac less_eq_frac of_frac |
230 hide (open) type bisim_iterator pair_box fun_box |
251 hide (open) type bisim_iterator pair_box fun_box |
231 hide (open) fact If_def Ex1_def rtrancl_def rtranclp_def tranclp_def refl'_def |
252 hide (open) fact If_def Ex1_def rtrancl_def rtranclp_def tranclp_def refl'_def |
232 wf'_def wf_wfrec'_def wfrec'_def card'_def setsum'_def fold_graph'_def |
253 wf'_def wf_wfrec'_def wfrec'_def card'_def setsum'_def fold_graph'_def |
233 The_psimp Eps_psimp unit_case_def nat_case_def dvd_def list_size_simp |
254 The_psimp Eps_psimp unit_case_def nat_case_def list_size_simp nat_gcd_def |
234 nat_gcd_def nat_lcm_def int_gcd_def int_lcm_def Frac_def zero_frac_def |
255 nat_lcm_def int_gcd_def int_lcm_def Frac_def zero_frac_def one_frac_def |
235 one_frac_def num_def denom_def norm_frac_def frac_def plus_frac_def |
256 num_def denom_def norm_frac_def frac_def plus_frac_def times_frac_def |
236 times_frac_def uminus_frac_def number_of_frac_def inverse_frac_def |
257 uminus_frac_def number_of_frac_def inverse_frac_def less_eq_frac_def |
237 less_eq_frac_def of_frac_def |
258 of_frac_def |
238 |
259 |
239 end |
260 end |