update fresh_fun_simp for debugging purposes
authornarboux
Tue, 24 Apr 2007 18:06:04 +0200
changeset 22787 85e7e32e6004
parent 22786 d8d7a53ffb63
child 22788 3038bd211582
update fresh_fun_simp for debugging purposes
src/HOL/Nominal/nominal_fresh_fun.ML
--- a/src/HOL/Nominal/nominal_fresh_fun.ML	Tue Apr 24 17:16:55 2007 +0200
+++ b/src/HOL/Nominal/nominal_fresh_fun.ML	Tue Apr 24 18:06:04 2007 +0200
@@ -57,7 +57,7 @@
 compile time. *)
 
 val at_exists_fresh' = thm "at_exists_fresh'";
-val fresh_fun_app = thm "fresh_fun_app";
+val fresh_fun_app' = thm "fresh_fun_app'";
 val fresh_prod = thm "fresh_prod";
 
 (* A tactic to generate a name fresh for 
@@ -131,7 +131,7 @@
     val abs_fresh = PureThy.get_thms thy (Name "abs_fresh");
     val ss' = ss addsimps fresh_prod::abs_fresh;
     val x = hd (tl (term_vars (prop_of exI)));
-    val goal = List.nth(prems_of thm, i-1);
+    val goal = nth (prems_of thm) (i-1);
     val atom_name_opt = get_inner_fresh_fun goal;
     val n = List.length (Logic.strip_params goal);
     (* Here we rely on the fact that the variable introduced by generate_fresh_tac is the last one in the list, the inner one *)
@@ -143,20 +143,27 @@
     val atom_basename = Sign.base_name atom_name;
     val pt_name_inst = get_dyn_thm thy ("pt_"^atom_basename^"_inst") atom_basename;
     val at_name_inst = get_dyn_thm thy ("at_"^atom_basename^"_inst") atom_basename;
-    fun tac_a i = 
-      res_inst_tac_term' [(x,Bound n)] false exI i THEN
-      asm_full_simp_tac ss' i                      THEN 
-      NominalPermeq.fresh_guess_tac HOL_ss i;
+    fun inst_fresh vars params i st =
+   let val vars' = term_vars (prop_of st);
+       val thy = theory_of_thm st;
+   in case vars' \\ vars of 
+     [x] => Seq.single (Thm.instantiate ([],[(cterm_of thy x,cterm_of thy (list_abs (params,Bound 0)))]) st)
+    | _ => error "fresh_fun_simp: Too many variables, please report."
+  end
   in
-  (generate_fresh_tac atom_name i      THEN 
-   subst_outer_tac ctx fresh_fun_app i THENL 
+  ( (* generate_fresh_tac atom_name i      THEN *) 
+  (fn st =>
+  let 
+    val vars = term_vars (prop_of st);
+    val params = Logic.strip_params (nth (prems_of st) (i-1))
+  in
+   (subst_outer_tac ctx fresh_fun_app' i THENL 
    [rtac pt_name_inst,
-    rtac at_name_inst, 
-    (fn i => TRY (NominalPermeq.finite_guess_tac HOL_ss i)),   
-    tac_a, 
-    (fn i => TRY (NominalPermeq.fresh_guess_tac  HOL_ss i)),
-    (fn i => auto_tac (HOL_cs, HOL_ss)) 
-]) thm 
+    rtac at_name_inst,
+    (K all_tac),
+    inst_fresh vars params]) st
+  end)) thm
+  
   end
   end