src/HOL/antisym_setup.ML
author nipkow
Tue, 09 Aug 2005 11:44:38 +0200
changeset 17040 6682c93b7d9f
parent 16833 a4e99217e9f9
child 17876 b9c92f384109
permissions -rw-r--r--
added finite(option) to Recdef.thy
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
16833
a4e99217e9f9 HOL.Not;
wenzelm
parents: 15531
diff changeset
     1
a4e99217e9f9 HOL.Not;
wenzelm
parents: 15531
diff changeset
     2
(* $Id$ *)
a4e99217e9f9 HOL.Not;
wenzelm
parents: 15531
diff changeset
     3
15198
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
     4
local
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
     5
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
     6
val order_antisym_conv = thm "order_antisym_conv"
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
     7
val linorder_antisym_conv1 = thm "linorder_antisym_conv1"
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
     8
val linorder_antisym_conv2 = thm "linorder_antisym_conv2"
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
     9
val linorder_antisym_conv3 = thm "linorder_antisym_conv3"
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    10
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    11
fun prp t thm = (#prop(rep_thm thm) = t);
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    12
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    13
fun prove_antisym_le sg ss ((le as Const(_,T)) $ r $ s) =
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    14
  let val prems = prems_of_ss ss;
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    15
      val less = Const("op <",T);
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    16
      val t = HOLogic.mk_Trueprop(le $ s $ r);
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    17
  in case Library.find_first (prp t) prems of
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    18
       NONE =>
16833
a4e99217e9f9 HOL.Not;
wenzelm
parents: 15531
diff changeset
    19
         let val t = HOLogic.mk_Trueprop(HOLogic.Not $ (less $ r $ s))
15198
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    20
         in case Library.find_first (prp t) prems of
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    21
              NONE => NONE
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    22
            | SOME thm => SOME(mk_meta_eq(thm RS linorder_antisym_conv1))
15198
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    23
         end
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    24
     | SOME thm => SOME(mk_meta_eq(thm RS order_antisym_conv))
15198
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    25
  end
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    26
  handle THM _ => NONE;
15198
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    27
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    28
fun prove_antisym_less sg ss (NotC $ ((less as Const(_,T)) $ r $ s)) =
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    29
  let val prems = prems_of_ss ss;
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    30
      val le = Const("op <=",T);
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    31
      val t = HOLogic.mk_Trueprop(le $ r $ s);
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    32
  in case Library.find_first (prp t) prems of
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    33
       NONE =>
15198
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    34
         let val t = HOLogic.mk_Trueprop(NotC $ (less $ s $ r))
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    35
         in case Library.find_first (prp t) prems of
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    36
              NONE => NONE
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    37
            | SOME thm => SOME(mk_meta_eq(thm RS linorder_antisym_conv3))
15198
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    38
         end
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    39
     | SOME thm => SOME(mk_meta_eq(thm RS linorder_antisym_conv2))
15198
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    40
  end
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15198
diff changeset
    41
  handle THM _ => NONE;
15198
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    42
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    43
val antisym_le = Simplifier.simproc (Theory.sign_of (the_context()))
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    44
  "antisym le" ["(x::'a::order) <= y"] prove_antisym_le;
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    45
val antisym_less = Simplifier.simproc (Theory.sign_of (the_context()))
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    46
  "antisym less" ["~ (x::'a::linorder) < y"] prove_antisym_less;
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    47
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    48
in
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    49
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    50
val antisym_setup =
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    51
 [Simplifier.change_simpset_of (op addsimprocs) [antisym_le,antisym_less]];
44495334adcc antisymmetry simproc
nipkow
parents:
diff changeset
    52
16833
a4e99217e9f9 HOL.Not;
wenzelm
parents: 15531
diff changeset
    53
end