QuotMain.thy
changeset 292 bd76f0398aa9
parent 289 7e8617f20b59
child 293 653460d3e849
--- a/QuotMain.thy	Thu Nov 05 13:47:41 2009 +0100
+++ b/QuotMain.thy	Thu Nov 05 16:43:57 2009 +0100
@@ -669,14 +669,13 @@
 )
 *}
 
-
-
 ML {*
 fun quotient_tac quot_thm =
   REPEAT_ALL_NEW (FIRST' [
     rtac @{thm FUN_QUOTIENT},
     rtac quot_thm,
-    rtac @{thm IDENTITY_QUOTIENT}
+    rtac @{thm IDENTITY_QUOTIENT},
+    (fn i => CHANGED (simp_tac (HOL_ss addsimps @{thms FUN_MAP_I}) i) THEN rtac @{thm IDENTITY_QUOTIENT} i)
   ])
 *}
 
@@ -766,7 +765,8 @@
      (simp_tac ((Simplifier.context ctxt HOL_ss) addsimps @{thms FUN_REL.simps}))
      THEN_ALL_NEW (fn _ => no_tac)
     ),
-    WEAK_LAMBDA_RES_TAC ctxt
+    WEAK_LAMBDA_RES_TAC ctxt,
+    (fn i => CHANGED (asm_full_simp_tac (HOL_ss addsimps @{thms FUN_REL_EQ}) i))
     ])
 *}
 
@@ -793,26 +793,32 @@
   apply (simp_all add: map.simps)
 done
 
+ML {*
+fun simp_ids lthy thm =
+  thm
+  |> MetaSimplifier.rewrite_rule @{thms id_def_sym}
+  |> repeat_eqsubst_thm lthy @{thms FUN_MAP_I id_apply prod_fun_id map_id}
+*}
+
 text {* expects atomized definition *}
 ML {*
-  fun add_lower_defs_aux ctxt thm =
+  fun add_lower_defs_aux lthy thm =
     let
       val e1 = @{thm fun_cong} OF [thm];
-      val f = eqsubst_thm ctxt @{thms fun_map.simps} e1;
-      val g = MetaSimplifier.rewrite_rule @{thms id_def_sym} f;
-      val h = repeat_eqsubst_thm ctxt @{thms FUN_MAP_I id_apply prod_fun_id map_id} g
+      val f = eqsubst_thm lthy @{thms fun_map.simps} e1;
+      val g = simp_ids lthy f
     in
-      thm :: (add_lower_defs_aux ctxt h)
+      (simp_ids lthy thm) :: (add_lower_defs_aux lthy g)
     end
-    handle _ => [thm]
+    handle _ => [simp_ids lthy thm]
 *}
 
 ML {*
-fun add_lower_defs ctxt defs =
+fun add_lower_defs lthy def =
   let
-    val defs_pre_sym = map symmetric defs
-    val defs_atom = map atomize_thm defs_pre_sym
-    val defs_all = flat (map (add_lower_defs_aux ctxt) defs_atom)
+    val def_pre_sym = symmetric def
+    val def_atom = atomize_thm def_pre_sym
+    val defs_all = add_lower_defs_aux lthy def_atom
   in
     map Thm.varifyT defs_all
   end
@@ -1012,9 +1018,10 @@
   val app_prs_thms = map (applic_prs lthy rty qty absrep) aps;
   val lam_prs_thms = map (make_simp_prs_thm lthy quot @{thm LAMBDA_PRS}) abs;
   val t_l = repeat_eqsubst_thm lthy (lam_prs_thms @ app_prs_thms) t_a;
-  val defs_sym = add_lower_defs lthy defs;
+  val defs_sym = flat (map (add_lower_defs lthy) defs);
   val defs_sym_eq = map (fn x => eq_reflection OF [x]) defs_sym;
-  val t_d0 = MetaSimplifier.rewrite_rule defs_sym_eq t_l;
+  val t_id = simp_ids lthy t_l;
+  val t_d0 = MetaSimplifier.rewrite_rule defs_sym_eq t_id;
   val t_d = repeat_eqsubst_thm lthy defs_sym t_d0;
   val t_r = MetaSimplifier.rewrite_rule [reps_same] t_d;
   val t_rv = ObjectLogic.rulify t_r