Congruence rules use == in premises now.
authornipkow
Fri, 20 Feb 1998 17:56:39 +0100
changeset 4640 ac6cf9f18653
parent 4639 bc6e2936a293
child 4641 70a50c2a920f
Congruence rules use == in premises now. New class linord.
src/HOL/Nat.thy
src/HOL/NatDef.ML
src/HOL/Ord.ML
src/HOL/Ord.thy
src/HOL/simpdata.ML
--- a/src/HOL/Nat.thy	Fri Feb 20 17:33:14 1998 +0100
+++ b/src/HOL/Nat.thy	Fri Feb 20 17:56:39 1998 +0100
@@ -23,6 +23,7 @@
 
 
 instance nat :: order (le_refl,le_trans,le_anti_sym,nat_less_le)
+instance nat :: linorder (nat_le_linear)
 
 consts
   "^"           :: ['a::power,nat] => 'a            (infixr 80)
--- a/src/HOL/NatDef.ML	Fri Feb 20 17:33:14 1998 +0100
+++ b/src/HOL/NatDef.ML	Fri Feb 20 17:56:39 1998 +0100
@@ -588,7 +588,15 @@
 by (blast_tac (claset() addSDs [le_imp_less_or_eq]) 1);
 qed "nat_less_le";
 
-(** max **)
+(* Axiom 'linorder_linear' of class 'linorder': *)
+goal thy "(m::nat) <= n | n <= m";
+by (simp_tac (simpset() addsimps [le_eq_less_or_eq]) 1);
+by (cut_facts_tac [less_linear] 1);
+by(Blast_tac 1);
+qed "nat_le_linear";
+
+
+(** max
 
 goalw thy [max_def] "!!z::nat. (z <= max x y) = (z <= x | z <= y)";
 by (simp_tac (simpset() addsimps [not_le_iff_less] addsplits [expand_if]) 1);
@@ -612,7 +620,7 @@
 by (simp_tac (simpset() addsimps [not_le_iff_less] addsplits [expand_if]) 1);
 by (blast_tac (claset() addIs [less_imp_le, le_trans]) 1);
 qed "min_le_iff_disj";
-
+ **)
 
 (** LEAST -- the least number operator **)
 
@@ -624,8 +632,6 @@
 goalw thy [Least_def]
   "(LEAST n::nat. P n) == (@n. P(n) & (ALL m. m < n --> ~P(m)))";
 by (simp_tac (simpset() addsimps [lemma]) 1);
-by (rtac eq_reflection 1);
-by (rtac refl 1);
 qed "Least_nat_def";
 
 val [prem1,prem2] = goalw thy [Least_nat_def]
--- a/src/HOL/Ord.ML	Fri Feb 20 17:33:14 1998 +0100
+++ b/src/HOL/Ord.ML	Fri Feb 20 17:56:39 1998 +0100
@@ -54,3 +54,38 @@
 by (Asm_simp_tac 1);
 by (blast_tac (claset() addIs [order_antisym]) 1);
 qed "min_leastR";
+
+
+section "Linear/Total Orders";
+
+goal thy "!!x::'a::linorder. x<y | x=y | y<x";
+by (simp_tac (simpset() addsimps [order_less_le]) 1);
+by(cut_facts_tac [linorder_linear] 1);
+by (Blast_tac 1);
+qed "linorder_less_linear";
+
+goalw thy [max_def] "!!z::'a::linorder. (z <= max x y) = (z <= x | z <= y)";
+by (simp_tac (simpset() addsimps [] addsplits [expand_if]) 1);
+by(cut_facts_tac [linorder_linear] 1);
+by (blast_tac (claset() addIs [order_trans]) 1);
+qed "le_max_iff_disj";
+
+goalw thy [max_def] "!!z::'a::linorder. (max x y <= z) = (x <= z & y <= z)";
+by (simp_tac (simpset() addsimps [] addsplits [expand_if]) 1);
+by(cut_facts_tac [linorder_linear] 1);
+by (blast_tac (claset() addIs [order_trans]) 1);
+qed "max_le_iff_conj";
+
+goalw thy [min_def] "!!z::'a::linorder. (z <= min x y) = (z <= x & z <= y)";
+by (simp_tac (simpset() addsimps [] addsplits [expand_if]) 1);
+by(cut_facts_tac [linorder_linear] 1);
+by (blast_tac (claset() addIs [order_trans]) 1);
+qed "le_min_iff_conj";
+
+goalw thy [min_def] "!!z::'a::linorder. (min x y <= z) = (x <= z | y <= z)";
+by (simp_tac (simpset() addsimps [] addsplits [expand_if]) 1);
+by(cut_facts_tac [linorder_linear] 1);
+by (blast_tac (claset() addIs [order_trans]) 1);
+qed "min_le_iff_disj";
+
+
--- a/src/HOL/Ord.thy	Fri Feb 20 17:33:14 1998 +0100
+++ b/src/HOL/Ord.thy	Fri Feb 20 17:56:39 1998 +0100
@@ -45,4 +45,7 @@
   order_antisym "[| x <= y; y <= x |] ==> x = y"
   order_less_le "x < y = (x <= y & x ~= y)"
 
+axclass linorder < order
+  linorder_linear "x <= y | y <= x"
+
 end
--- a/src/HOL/simpdata.ML	Fri Feb 20 17:33:14 1998 +0100
+++ b/src/HOL/simpdata.ML	Fri Feb 20 17:56:39 1998 +0100
@@ -52,6 +52,9 @@
 val DelIffs = seq delIff
 end;
 
+qed_goal "meta_eq_to_obj_eq" HOL.thy "x==y ==> x=y"
+  (fn [prem] => [rewtac prem, rtac refl 1]);
+
 local
 
   fun prover s = prove_goal HOL.thy s (K [blast_tac HOL_cs 1]);
@@ -95,7 +98,7 @@
  [ "(x=x) = True",
    "(~True) = False", "(~False) = True", "(~ ~ P) = P",
    "(~P) ~= P", "P ~= (~P)", "(P ~= Q) = (P = (~Q))",
-   "(True=P) = P", "(P=True) = P",
+   "(True=P) = P", "(P=True) = P", "(False=P) = (~P)", "(P=False) = (~P)",
    "(True --> P) = P", "(False --> P) = True", 
    "(P --> True) = True", "(P --> P) = True",
    "(P --> False) = (~P)", "(P --> ~P) = (~P)",
@@ -115,11 +118,15 @@
 
 (*Add congruence rules for = (instead of ==) *)
 infix 4 addcongs delcongs;
-fun ss addcongs congs = ss addeqcongs 
-                        (map standard (congs RL [eq_reflection]));
 
-fun ss delcongs congs = ss deleqcongs 
-                        (map standard (congs RL [eq_reflection]));
+fun mk_meta_cong rl =
+  standard(mk_meta_eq(replicate (nprems_of rl) meta_eq_to_obj_eq MRS rl))
+  handle THM _ =>
+  error("Premises and conclusion of congruence rules must be =-equalities");
+
+fun ss addcongs congs = ss addeqcongs (map mk_meta_cong congs);
+
+fun ss delcongs congs = ss deleqcongs (map mk_meta_cong congs);
 
 fun Addcongs congs = (simpset_ref() := simpset() addcongs congs);
 fun Delcongs congs = (simpset_ref() := simpset() delcongs congs);
@@ -241,9 +248,6 @@
 qed_goalw "o_apply" HOL.thy [o_def] "(f o g) x = f (g x)"
  (K [rtac refl 1]);
 
-qed_goal "meta_eq_to_obj_eq" HOL.thy "x==y ==> x=y"
-  (fn [prem] => [rewtac prem, rtac refl 1]);
-
 qed_goalw "if_True" HOL.thy [if_def] "(if True then x else y) = x"
  (K [Blast_tac 1]);
 
@@ -370,10 +374,10 @@
    ("All", [spec]), ("True", []), ("False", []),
    ("If", [if_bool_eq RS iffD1])];
 
-fun unsafe_solver prems = FIRST'[resolve_tac (TrueI::refl::prems),
+fun unsafe_solver prems = FIRST'[resolve_tac (reflexive_thm::TrueI::refl::prems),
 				 atac, etac FalseE];
 (*No premature instantiation of variables during simplification*)
-fun   safe_solver prems = FIRST'[match_tac (TrueI::refl::prems),
+fun   safe_solver prems = FIRST'[match_tac (reflexive_thm::TrueI::prems),
 				 eq_assume_tac, ematch_tac [FalseE]];
 
 val HOL_basic_ss = empty_ss setsubgoaler asm_simp_tac