1 (* Title: HOL/Nitpick_Examples/Mono_Nits.thy
2 Author: Jasmin Blanchette, TU Muenchen
5 Examples featuring Nitpick's monotonicity check.
8 header {* Examples Featuring Nitpick's Monotonicity Check *}
18 val defs = Nitpick_HOL.all_axioms_of @{theory} subst |> #1
19 val def_table = Nitpick_HOL.const_def_table @{context} subst defs
20 val hol_ctxt : Nitpick_HOL.hol_context =
21 {thy = @{theory}, ctxt = @{context}, max_bisim_depth = ~1, boxes = [],
22 stds = [(NONE, true)], wfs = [], user_axioms = NONE, debug = false,
23 binary_ints = SOME false, destroy_constrs = false, specialize = false,
24 star_linear_preds = false, fast_descrs = false, tac_timeout = NONE,
25 evals = [], case_names = [], def_table = def_table,
26 nondef_table = Symtab.empty, user_nondefs = [],
27 simp_table = Unsynchronized.ref Symtab.empty, psimp_table = Symtab.empty,
28 choice_spec_table = Symtab.empty, intro_table = Symtab.empty,
29 ground_thm_table = Inttab.empty, ersatz_table = [],
30 skolems = Unsynchronized.ref [], special_funs = Unsynchronized.ref [],
31 unrolled_preds = Unsynchronized.ref [], wf_cache = Unsynchronized.ref [],
32 constr_cache = Unsynchronized.ref []}
35 Nitpick_Mono.formulas_monotonic hol_ctxt false @{typ 'a} ([t], [])
37 let val T = fastype_of t in
38 is_mono (Logic.mk_implies (Logic.mk_equals (Free ("dummyP", T), t),
41 fun mono t = is_mono t orelse raise FAIL
42 fun nonmono t = not (is_mono t) orelse raise FAIL
43 fun const t = is_const t orelse raise FAIL
44 fun nonconst t = not (is_const t) orelse raise FAIL
47 ML {* const @{term "A::('a\<Rightarrow>'b)"} *}
48 ML {* const @{term "(A::'a set) = A"} *}
49 ML {* const @{term "(A::'a set set) = A"} *}
50 ML {* const @{term "(\<lambda>x::'a set. x a)"} *}
51 ML {* const @{term "{{a::'a}} = C"} *}
52 ML {* const @{term "{f::'a\<Rightarrow>nat} = {g::'a\<Rightarrow>nat}"} *}
53 ML {* const @{term "A \<union> (B::'a set)"} *}
54 ML {* const @{term "P (a::'a)"} *}
55 ML {* const @{term "\<lambda>a::'a. b (c (d::'a)) (e::'a) (f::'a)"} *}
56 ML {* const @{term "\<forall>A::'a set. A a"} *}
57 ML {* const @{term "\<forall>A::'a set. P A"} *}
58 ML {* const @{term "P \<or> Q"} *}
59 ML {* const @{term "A \<union> B = (C::'a set)"} *}
60 ML {* const @{term "(if P then (A::'a set) else B) = C"} *}
61 ML {* const @{term "let A = (C::'a set) in A \<union> B"} *}
62 ML {* const @{term "THE x::'b. P x"} *}
63 ML {* const @{term "(\<lambda>x::'a. False)"} *}
64 ML {* const @{term "(\<lambda>x::'a. True)"} *}
65 ML {* const @{term "Let (a::'a) A"} *}
66 ML {* const @{term "A (a::'a)"} *}
67 ML {* const @{term "insert (a::'a) A = B"} *}
68 ML {* const @{term "- (A::'a set)"} *}
69 ML {* const @{term "finite (A::'a set)"} *}
70 ML {* const @{term "\<not> finite (A::'a set)"} *}
71 ML {* const @{term "finite (A::'a set set)"} *}
72 ML {* const @{term "\<lambda>a::'a. A a \<and> \<not> B a"} *}
73 ML {* const @{term "A < (B::'a set)"} *}
74 ML {* const @{term "A \<le> (B::'a set)"} *}
75 ML {* const @{term "[a::'a]"} *}
76 ML {* const @{term "[a::'a set]"} *}
77 ML {* const @{term "[A \<union> (B::'a set)]"} *}
78 ML {* const @{term "[A \<union> (B::'a set)] = [C]"} *}
80 ML {* nonconst @{term "{(\<lambda>x::'a. x = a)} = C"} *}
81 ML {* nonconst @{term "\<forall>P (a::'a). P a"} *}
82 ML {* nonconst @{term "\<forall>a::'a. P a"} *}
83 ML {* nonconst @{term "(\<lambda>a::'a. \<not> A a) = B"} *}
84 ML {* nonconst @{term "THE x::'a. P x"} *}
85 ML {* nonconst @{term "SOME x::'a. P x"} *}
87 ML {* mono @{prop "Q (\<forall>x::'a set. P x)"} *}
88 ML {* mono @{prop "P (a::'a)"} *}
89 ML {* mono @{prop "{a} = {b::'a}"} *}
90 ML {* mono @{prop "P (a::'a) \<and> P \<union> P = P"} *}
91 ML {* mono @{prop "\<forall>F::'a set set. P"} *}
92 ML {* mono @{prop "\<not> (\<forall>F f g (h::'a set). F f \<and> F g \<and> \<not> f a \<and> g a \<longrightarrow> F h)"} *}
93 ML {* mono @{prop "\<not> Q (\<forall>x::'a set. P x)"} *}
94 ML {* mono @{prop "\<not> (\<forall>x::'a. P x)"} *}
96 ML {* nonmono @{prop "\<forall>x::'a. P x"} *}
97 ML {* nonmono @{prop "myall P = (P = (\<lambda>x::'a. True))"} *}
98 ML {* nonmono @{prop "\<forall>F f g (h::'a set). F f \<and> F g \<and> \<not> f a \<and> g a \<longrightarrow> F h"} *}