theory Mono_Nits imports Main (* "~/afp/thys/DPT-SAT-Solver/DPT_SAT_Solver" *) (* "~/afp/thys/AVL-Trees/AVL2" "~/afp/thys/Huffman/Huffman" *) begin
ML ‹ open Nitpick_Util open Nitpick_HOL open Nitpick_Preproc exception BUG val thy = 🍋 val ctxt = 🍋 val subst = [] val tac_timeout = seconds 1.0 val case_names = case_const_names ctxt val defs = all_defs_of thy subst val nondefs = all_nondefs_of ctxt subst val def_tables = const_def_tables ctxt subst defs val nondef_table = const_nondef_table nondefs val simp_table = Unsynchronized.ref (const_simp_table ctxt subst) val psimp_table = const_psimp_table ctxt subst val choice_spec_table = const_choice_spec_table ctxt subst val intro_table = inductive_intro_table ctxt subst def_tables val ground_thm_table = ground_theorem_table thy val ersatz_table = ersatz_table ctxt val hol_ctxt as {thy, ...} : hol_context = {thy = thy, ctxt = ctxt, max_bisim_depth = ~1, boxes = [], wfs = [], user_axioms = NONE, debug = false, whacks = [], binary_ints = SOME false, destroy_constrs = true, specialize = false, star_linear_preds = false, total_consts = NONE, needs = NONE, tac_timeout = tac_timeout, evals = [], case_names = case_names, def_tables = def_tables, nondef_table = nondef_table, nondefs = nondefs, simp_table = simp_table, psimp_table = psimp_table, choice_spec_table = choice_spec_table, intro_table = intro_table, ground_thm_table = ground_thm_table, ersatz_table = ersatz_table, skolems = Unsynchronized.ref [], special_funs = Unsynchronized.ref [], unrolled_preds = Unsynchronized.ref [], wf_cache = Unsynchronized.ref [], constr_cache = Unsynchronized.ref []} val binarize = false fun is_mono t = Nitpick_Mono.formulas_monotonic hol_ctxt binarize 🍋‹'a› (
fun is_const t = let val T = fastype_of t in
Logic.mk_implies (Logic.mk_equals (Free ("dummyP", T), t), 🍋‹False›)
|> is_mono end
fun mono t = is_mono t orelse raise BUG fun nonmono t = not (is_mono t) orelse raise BUG fun const t = is_const t orelse raise BUG fun nonconst t = not (is_const t) orelse raise BUG ›
ML ‹Nitpick_Mono.trace := false›
ML_val ‹const 🍋‹A::('a==>'b)›\
ML_val ‹const 🍋‹(A::'a set) = A›\
ML_val ‹const 🍋‹(A::'a set set) = A›\›
ML_val ‹const 🍋‹(λx::'a set. a ∈ x)›\›
ML_val ‹const 🍋‹{{a::'a}} = C›\›
ML_val ‹const 🍋‹{f::'a==>nat} = {g::'a==>nat}›\›
ML_val ‹const 🍋‹A ∪ (B::'a set)›\›
ML_val ‹const 🍋‹λA B x::'a. A x ∨ B x›\›
ML_val ‹const 🍋‹P (a::'a)›\›
ML_val ‹const 🍋‹λa::'a. b (c (d::'a)) (e::'a) (f::'a)›\›
ML_val ‹const 🍋‹∀A::'a set. a ∈ A›\›
ML_val ‹const 🍋‹∀A::'a set. P A›\›
ML_val ‹const 🍋‹P ∨ Q›\›
ML_val ‹const 🍋‹A ∪ B = (C::'a set)›\›
ML_val ‹const 🍋‹(λA B x::'a. A x ∨ B x) A B = C›\›
ML_val ‹const 🍋‹(if P then (A::'a set) else B) = C›\›
ML_val ‹const 🍋‹let A = (C::'a set) in A ∪ B›\›
ML_val ‹const 🍋‹THE x::'b. P x›\›
ML_val ‹const 🍋‹(λx::'a. False)›\›
ML_val ‹const 🍋‹(λx::'a. True)›\›
ML_val ‹const 🍋‹(λx::'a. False) = (λx::'a. False)›\›
ML_val ‹const 🍋‹(λx::'a. True) = (λx::'a. True)›\›
ML_val ‹const 🍋‹Let (a::'a) A›\›
ML_val ‹const 🍋‹A (a::'a)›\›
ML_val ‹const 🍋‹insert (a::'a) A = B›\›
ML_val ‹const 🍋‹- (A::'a set)›\›
ML_val ‹const 🍋‹finite (A::'a set)›\›
ML_val ‹const 🍋‹¬ finite (A::'a set)›\›
ML_val ‹const 🍋‹finite (A::'a set set)›\›
ML_val ‹const 🍋‹λa::'a. A a ∧¬ B a›\›
ML_val ‹const 🍋‹A 🚫B::'a set)›\›
ML_val ‹const 🍋‹A ≤ (B::'a set)›\›
ML_val ‹const 🍋‹[a::'a]›\›
ML_val ‹const 🍋‹[a::'a set]›\›
ML_val ‹const 🍋‹[A ∪ (B::'a set)]›\›
ML_val ‹const 🍋‹[A ∪ (B::'a set)] = [C]›\›
ML_val ‹const 🍋‹{(λx::'a. x = a)} = C›\›
ML_val ‹const 🍋‹(λa::'a. ¬ A a) = B›\›
ML_val ‹const 🍋‹∀F f g (h::'a set). F f ∧ F g ∧¬ f a ∧ g a ⟶¬ f a›\›
ML_val ‹const 🍋‹λA B x::'a. A x ∧ B x ∧ A = B›\›
ML_val ‹const 🍋‹p = (λ(x::'a) (y::'a). P x ∨¬ Q y)›\›
ML_val ‹const 🍋‹p = (λ(x::'a) (y::'a). p x y :: bool)›\›
ML_val ‹const 🍋‹p = (λA B x. A x ∧¬ B x) (λx. True) (λy. x ≠ y)›\›
ML_val ‹const 🍋‹p = (λy. x ≠ y)›\›
ML_val ‹const 🍋‹(λx. (p::'a==>bool==>bool) x False)›\›
ML_val ‹const 🍋‹(λx y. (p::'a==>'a==>bool==>bool) x y False)›\›
ML_val ‹const 🍋‹f = (λx::'a. P x ⟶ Q x)›\›
ML_val ‹const 🍋‹∀a::'a. P a›\›
ML_val ‹nonconst 🍋‹∀P (a::'a). P a›\›
ML_val ‹nonconst 🍋‹THE x::'a. P x›\›
ML_val ‹nonconst 🍋‹SOME x::'a. P x›\›
ML_val ‹nonconst 🍋‹(λA B x::'a. A x ∨ B x) = myunion›\›
ML_val ‹nonconst 🍋‹(λx::'a. False) = (λx::'a. True)›\›
ML_val ‹nonconst 🍋‹∀F f g (h::'a set). F f ∧ F g ∧¬ a ∈ f ∧ a ∈ g ⟶ F h›\›
ML_val ‹mono 🍋‹Q (∀x::'a set. P x)›\›
ML_val ‹mono 🍋‹P (a::'a)›\›
ML_val ‹mono 🍋‹{a} = {b::'a}›\›
ML_val ‹mono 🍋‹(λx. x = a) = (λy. y = (b::'a))›\›
ML_val ‹mono 🍋‹(a::'a) ∈ P ∧ P ∪ P = P›\›
ML_val ‹mono 🍋‹∀F::'a set set. P›\›
ML_val ‹mono 🍋‹¬ (∀F f g (h::'a set). F f ∧ F g ∧¬ a ∈ f ∧ a ∈ g ⟶ F h)›\›
ML_val ‹mono 🍋‹¬ Q (∀x::'a set. P x)›\›
ML_val ‹mono 🍋‹¬ (∀x::'a. P x)›\›
ML_val ‹mono 🍋‹myall P = (P = (λx::'a. True))›\›
ML_val ‹mono 🍋‹myall P = (P = (λx::'a. False))›\›
ML_val ‹mono 🍋‹∀x::'a. P x›\›
ML_val ‹mono 🍋‹(λA B x::'a. A x ∨ B x) ≠ myunion›\›
ML_val ‹nonmono 🍋‹A = (λx::'a. True) ∧ A = (λx. False)›\›
ML_val ‹nonmono 🍋‹∀F f g (h::'a set). F f ∧ F g ∧¬ a ∈ f ∧ a ∈ g ⟶ F h›\›
ML ‹ val preproc_timeout = seconds 5.0 val mono_timeout = seconds 1.0 fun is_forbidden_theorem name = Long_Name.count name d='alert("unvollständiges Symbol >");' >🚫2 orelse String.isPrefix "type_definition" (List.last (Long_Name.explode name)) orelse String.isPrefix "arity_" (List.last (Long_Name.explode name)) orelse String.isSuffix "_def" name orelse String.isSuffix "_raw" name fun theorems_of thy = filter (fn ((name, _), th) => not (is_forbidden_theorem name) andalso Thm.theory_long_name th = Context.theory_long_name thy) (Global_Theory.all_thms_of thy true) fun check_formulas tsp = 🍋‹ let fun is_type_actually_monotonic T = Nitpick_Mono.formulas_monotonic hol_ctxt binarize T tsp val free_Ts = fold Term.add_tfrees ((op @) tsp) [] |> map TFree val (mono_free_Ts, nonmono_free_Ts) = Timeout.apply mono_timeout (List.partition is_type_actually_monotonic) free_Ts in if not (null mono_free_Ts) then "MONO" else if not (null nonmono_free_Ts) then "NONMONO" else "NIX" end catch Timeout.TIMEOUT _ => "TIMEOUT" | NOT_SUPPORTED _ => "UNSUP" | _ => "UNKNOWN" › fun check_theory thy = let val path = File.tmp_path (Context.theory_base_name thy ^ ".out" |> Path.explode) val _ = File.write path "" fun check_theorem (name, th) = let val t = th |> Thm.prop_of |> Type.legacy_freeze |> close_form val neg_t = Logic.mk_implies (t, 🍋‹False›) val (nondef_ts, def_ts, _, _, _, _) = Timeout.apply preproc_timeout (preprocess_formulas hol_ctxt []) neg_t val res = Thm_Name.print name ^ ": " ^ check_formulas (nondef_ts, def_ts) in File.append path (res ^ "\n"); writeln res end handle Timeout.TIMEOUT _ => () in thy |> theorems_of |> List.app check_theorem end ›
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.
