--- a/Quot/QuotMain.thy	Tue Dec 08 22:26:01 2009 +0100
+++ b/Quot/QuotMain.thy	Tue Dec 08 23:30:47 2009 +0100
@@ -1047,6 +1047,29 @@
 thm fun_map.simps Quotient_abs_rep Quotient_rel_rep id_simps 
 (* 4. Test for refl *)
 
+thm fun_map.simps
+
+ML {* Conv.abs_conv; term_of *}
+
+thm fun_map.simps[THEN eq_reflection]
+
+ML {*
+fun fun_map_conv xs ctxt ctrm =
+  case (term_of ctrm) of
+    ((Const (@{const_name "fun_map"}, _) $ _ $ _) $ h $ _) =>
+        (Conv.binop_conv (fun_map_conv xs ctxt) then_conv
+        (if (member (op=) xs h) 
+         then Conv.all_conv 
+         else Conv.rewr_conv @{thm fun_map.simps[THEN eq_reflection]})) ctrm
+    | _ $ _ => Conv.comb_conv (fun_map_conv xs ctxt) ctrm
+    | Abs _ => Conv.abs_conv (fn (x, ctxt) => fun_map_conv ((term_of x)::xs) ctxt) ctxt ctrm
+    | _ => Conv.all_conv ctrm
+*}
+
+ML {*
+fun fun_map_tac ctxt = CONVERSION (fun_map_conv [] ctxt)
+*}
+
 ML {*
 fun clean_tac lthy =
   let
@@ -1059,9 +1082,9 @@
     fun simps thms = (mk_minimal_ss lthy) addsimps thms addSolver quotient_solver
   in
     EVERY' [simp_tac (simps thms1),
+            fun_map_tac lthy,
             lambda_prs_tac lthy,
             simp_tac (simps thms2),
-            lambda_prs_tac lthy,
             TRY o rtac refl]
   end
 *}