QuotMain.thy
changeset 536 44fa9df44e6f
parent 529 6348c2a57ec2
child 537 57073b0b8fac
--- a/QuotMain.thy	Fri Dec 04 15:25:51 2009 +0100
+++ b/QuotMain.thy	Fri Dec 04 15:41:09 2009 +0100
@@ -143,7 +143,7 @@
 
 declare [[map list = (map, LIST_REL)]]
 declare [[map * = (prod_fun, prod_rel)]]
-declare [[map "fun" = (fun_map, FUN_REL)]]
+declare [[map "fun" = (fun_map, fun_rel)]]
 
 lemmas [quotient_thm] = 
   FUN_Quotient LIST_Quotient
@@ -540,7 +540,7 @@
   in
   case redex of
       (ogl as ((Const (@{const_name "Ball"}, _)) $
-        ((Const (@{const_name "Respects"}, _)) $ ((Const (@{const_name "FUN_REL"}, _)) $ R1 $ R2)) $ _)) =>
+        ((Const (@{const_name "Respects"}, _)) $ ((Const (@{const_name "fun_rel"}, _)) $ R1 $ R2)) $ _)) =>
       (let
         val gl = Const (@{const_name "equivp"}, dummyT) $ R2;
         val glc = HOLogic.mk_Trueprop (Syntax.check_term ctxt gl);
@@ -571,7 +571,7 @@
   in
   case redex of
       (ogl as ((Const (@{const_name "Bex"}, _)) $
-        ((Const (@{const_name "Respects"}, _)) $ ((Const (@{const_name "FUN_REL"}, _)) $ R1 $ R2)) $ _)) =>
+        ((Const (@{const_name "Respects"}, _)) $ ((Const (@{const_name "fun_rel"}, _)) $ R1 $ R2)) $ _)) =>
       (let
         val gl = Const (@{const_name "equivp"}, dummyT) $ R2;
         val glc = HOLogic.mk_Trueprop (Syntax.check_term ctxt gl);
@@ -728,37 +728,11 @@
      resolve_tac (quotient_rules_get ctxt)])
 *}
 
-lemma FUN_REL_I:
+lemma fun_rel_id:
   assumes a: "\<And>x y. R1 x y \<Longrightarrow> R2 (f x) (g y)"
   shows "(R1 ===> R2) f g"
 using a by simp
 
-ML {*
-val lambda_rsp_tac =
-  SUBGOAL (fn (goal, i) =>
-    case HOLogic.dest_Trueprop (Logic.strip_assums_concl goal) of
-       (_ $ (Abs _) $ (Abs _)) => rtac @{thm FUN_REL_I} i
-     | _ => no_tac)
-*}
-
-ML {*
-val ball_rsp_tac = 
-  SUBGOAL (fn (goal, i) =>
-    case HOLogic.dest_Trueprop (Logic.strip_assums_concl goal) of
-        (_ $ (Const (@{const_name Ball}, _) $ _) 
-           $ (Const (@{const_name Ball}, _) $ _)) => rtac @{thm FUN_REL_I} i
-      |_ => no_tac)
-*}
-
-ML {*
-val bex_rsp_tac = 
-  SUBGOAL (fn (goal, i) =>
-    case HOLogic.dest_Trueprop (Logic.strip_assums_concl goal) of
-        (_ $ (Const (@{const_name Bex}, _) $ _) 
-           $ (Const (@{const_name Bex}, _) $ _)) => rtac @{thm FUN_REL_I} i
-      | _ => no_tac)
-*}
-
 definition
   "QUOT_TRUE x \<equiv> True"
 
@@ -936,28 +910,28 @@
 fun inj_repabs_tac_match ctxt trans2 = SUBGOAL (fn (goal, i) =>
 (case HOLogic.dest_Trueprop (Logic.strip_assums_concl goal) of
     (* (R1 ===> R2) (\<lambda>x\<dots>) (\<lambda>y\<dots>) ----> \<lbrakk>R1 x y\<rbrakk> \<Longrightarrow> R2 (\<dots>x) (\<dots>y) *)
-  ((Const (@{const_name FUN_REL}, _) $ _ $ _) $ (Abs _) $ (Abs _))
-      => rtac @{thm FUN_REL_I} THEN' quot_true_tac ctxt unlam
+  ((Const (@{const_name fun_rel}, _) $ _ $ _) $ (Abs _) $ (Abs _))
+      => rtac @{thm fun_rel_id} THEN' quot_true_tac ctxt unlam
     (* (op =) (Ball\<dots>) (Ball\<dots>) ----> (op =) (\<dots>) (\<dots>) *)
 | (Const (@{const_name "op ="},_) $
     (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
     (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _))
       => rtac @{thm ball_rsp} THEN' dtac @{thm QT_all}
     (* (R1 ===> op =) (Ball\<dots>) (Ball\<dots>) ----> \<lbrakk>R1 x y\<rbrakk> \<Longrightarrow> (Ball\<dots>x) = (Ball\<dots>y) *)
-| (Const (@{const_name FUN_REL}, _) $ _ $ _) $
+| (Const (@{const_name fun_rel}, _) $ _ $ _) $
     (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
     (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _)
-      => rtac @{thm FUN_REL_I} THEN' quot_true_tac ctxt unlam
+      => rtac @{thm fun_rel_id} THEN' quot_true_tac ctxt unlam
     (* (op =) (Bex\<dots>) (Bex\<dots>) ----> (op =) (\<dots>) (\<dots>) *)
 | Const (@{const_name "op ="},_) $
     (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
     (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _)
       => rtac @{thm bex_rsp} THEN' dtac @{thm QT_ex}
     (* (R1 ===> op =) (Bex\<dots>) (Bex\<dots>) ----> \<lbrakk>R1 x y\<rbrakk> \<Longrightarrow> (Bex\<dots>x) = (Bex\<dots>y) *)
-| (Const (@{const_name FUN_REL}, _) $ _ $ _) $
+| (Const (@{const_name fun_rel}, _) $ _ $ _) $
     (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
     (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _)
-      => rtac @{thm FUN_REL_I} THEN' quot_true_tac ctxt unlam
+      => rtac @{thm fun_rel_id} THEN' quot_true_tac ctxt unlam
 | Const (@{const_name "op ="},_) $ _ $ _ => 
     (* reflexivity of operators arising from Cong_tac *)
     rtac @{thm refl} ORELSE'