src/HOL/Data_Structures/Less_False.thy
author nipkow
Sun, 24 May 2020 08:20:05 +0200
changeset 71858 864fade05842
parent 69597 ff784d5a5bfb
child 78099 4d9349989d94
permissions -rw-r--r--
simpler inductions
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
61640
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     1
(* Author: Tobias Nipkow *)
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     2
67406
23307fd33906 isabelle update_cartouches -c;
wenzelm
parents: 61640
diff changeset
     3
section \<open>Improved Simproc for $<$\<close>
61640
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     4
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     5
theory Less_False
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     6
imports Main
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     7
begin
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     8
67406
23307fd33906 isabelle update_cartouches -c;
wenzelm
parents: 61640
diff changeset
     9
simproc_setup less_False ("(x::'a::order) < y") = \<open>fn _ => fn ctxt => fn ct =>
61640
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    10
  let
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    11
    fun prp t thm = Thm.full_prop_of thm aconv t;
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    12
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    13
    val eq_False_if_not = @{thm eq_False} RS iffD2
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    14
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    15
    fun prove_less_False ((less as Const(_,T)) $ r $ s) =
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    16
      let val prems = Simplifier.prems_of ctxt;
69597
ff784d5a5bfb isabelle update -u control_cartouches;
wenzelm
parents: 67406
diff changeset
    17
          val le = Const (\<^const_name>\<open>less_eq\<close>, T);
61640
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    18
          val t = HOLogic.mk_Trueprop(le $ s $ r);
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    19
      in case find_first (prp t) prems of
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    20
           NONE =>
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    21
             let val t = HOLogic.mk_Trueprop(less $ s $ r)
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    22
             in case find_first (prp t) prems of
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    23
                  NONE => NONE
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    24
                | SOME thm => SOME(mk_meta_eq((thm RS @{thm less_not_sym}) RS eq_False_if_not))
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    25
             end
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    26
         | SOME thm => NONE
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    27
      end;
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    28
  in prove_less_False (Thm.term_of ct) end
67406
23307fd33906 isabelle update_cartouches -c;
wenzelm
parents: 61640
diff changeset
    29
\<close>
61640
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    30
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    31
end