File antisym_setup.ML (Isabelle2005: October 2005)

# File antisym_setup.ML

    (* $Id: antisym_setup.ML,v 1.3 2005/07/14 17:28:15 wenzelm Exp $ *)

    local

    val order_antisym_conv = thm "order_antisym_conv"
    val linorder_antisym_conv1 = thm "linorder_antisym_conv1"
    val linorder_antisym_conv2 = thm "linorder_antisym_conv2"
    val linorder_antisym_conv3 = thm "linorder_antisym_conv3"

    fun prp t thm = (#prop(rep_thm thm) = t);

    fun prove_antisym_le sg ss ((le as Const(_,T)) $ r $ s) =
      let val prems = prems_of_ss ss;
          val less = Const("op <",T);
          val t = HOLogic.mk_Trueprop(le $ s $ r);
      in case Library.find_first (prp t) prems of
           NONE =>
             let val t = HOLogic.mk_Trueprop(HOLogic.Not $ (less $ r $ s))
             in case Library.find_first (prp t) prems of
                  NONE => NONE
                | SOME thm => SOME(mk_meta_eq(thm RS linorder_antisym_conv1))
             end
         | SOME thm => SOME(mk_meta_eq(thm RS order_antisym_conv))
      end
      handle THM _ => NONE;

    fun prove_antisym_less sg ss (NotC $ ((less as Const(_,T)) $ r $ s)) =
      let val prems = prems_of_ss ss;
          val le = Const("op <=",T);
          val t = HOLogic.mk_Trueprop(le $ r $ s);
      in case Library.find_first (prp t) prems of
           NONE =>
             let val t = HOLogic.mk_Trueprop(NotC $ (less $ s $ r))
             in case Library.find_first (prp t) prems of
                  NONE => NONE
                | SOME thm => SOME(mk_meta_eq(thm RS linorder_antisym_conv3))
             end
         | SOME thm => SOME(mk_meta_eq(thm RS linorder_antisym_conv2))
      end
      handle THM _ => NONE;

    val antisym_le = Simplifier.simproc (Theory.sign_of (the_context()))
      "antisym le" ["(x::'a::order) <= y"] prove_antisym_le;
    val antisym_less = Simplifier.simproc (Theory.sign_of (the_context()))
      "antisym less" ["~ (x::'a::linorder) < y"] prove_antisym_less;

    in

    val antisym_setup =
     [Simplifier.change_simpset_of (op addsimprocs) [antisym_le,antisym_less]];

    end