src/HOL/Nominal/nominal_fresh_fun.ML
changeset 23091 c91530f18d9c
parent 23065 ab28e8398670
child 23094 f1df8d2da98a
equal deleted inserted replaced
23090:eb3000a5c478 23091:c91530f18d9c
     4 
     4 
     5 A tactic to generate fresh names.
     5 A tactic to generate fresh names.
     6 A tactic to get rid of the fresh_fun.
     6 A tactic to get rid of the fresh_fun.
     7 *)
     7 *)
     8 
     8 
     9 (* First some functions that could be
     9 (* First some functions that could be in the library *)
    10  in the library *)
       
    11 
    10 
    12 (* A tactical which applies a list of int -> tactic to the corresponding subgoals present after the application of another tactic. 
    11 (* A tactical which applies a list of int -> tactic to the corresponding subgoals present after the application of another tactic. 
    13 T THENL [A,B,C] is equivalent to T THEN (C 3 THEN B 2 THEN A 1) 
    12 T THENL [A,B,C] is equivalent to T THEN (C 3 THEN B 2 THEN A 1) 
    14 *)
    13 *)
    15 
    14 
    17 
    16 
    18 fun tac THENL tacs =
    17 fun tac THENL tacs =
    19  tac THEN
    18  tac THEN
    20   (EVERY (map  (fn (tac,i) => tac i) (rev tacs ~~ (length tacs downto 1))))
    19   (EVERY (map  (fn (tac,i) => tac i) (rev tacs ~~ (length tacs downto 1))))
    21 
    20 
       
    21 (* A tactical to test if a tactic completly solve a subgoal *)
       
    22 
    22 fun SOLVEI t = t THEN_ALL_NEW (fn i => no_tac);
    23 fun SOLVEI t = t THEN_ALL_NEW (fn i => no_tac);
       
    24 
       
    25 (* A version of TRY for int -> tactic *)
       
    26 
    23 fun TRY' tac i =  TRY (tac i);
    27 fun TRY' tac i =  TRY (tac i);
    24 
    28 
    25 fun gen_res_inst_tac_term instf tyinst tinst elim th i st =
    29 fun gen_res_inst_tac_term instf tyinst tinst elim th i st =
    26   let
    30   let
    27     val thy = theory_of_thm st;
    31     val thy = theory_of_thm st;
   119   case atom_name_opt of 
   123   case atom_name_opt of 
   120     NONE => all_tac thm
   124     NONE => all_tac thm
   121   | SOME atom_name  => generate_fresh_tac atom_name i thm               
   125   | SOME atom_name  => generate_fresh_tac atom_name i thm               
   122   end
   126   end
   123 
   127 
   124 (* A substitution tactic *)
   128 (* Two substitution tactics which looks for the inner most occurence in 
       
   129    one assumption or in the conclusion *)
   125 
   130 
   126 val search_fun     = curry (Seq.flat o (uncurry EqSubst.searchf_bt_unify_valid));
   131 val search_fun     = curry (Seq.flat o (uncurry EqSubst.searchf_bt_unify_valid));
   127 val search_fun_asm = EqSubst.skip_first_asm_occs_search EqSubst.searchf_bt_unify_valid;
   132 val search_fun_asm = EqSubst.skip_first_asm_occs_search EqSubst.searchf_bt_unify_valid;
   128 
   133 
   129 fun subst_outer_tac           ctx = EqSubst.eqsubst_tac' ctx search_fun;
   134 fun subst_inner_tac           ctx = EqSubst.eqsubst_tac' ctx search_fun;
   130 fun subst_outer_asm_tac_aux i ctx = EqSubst.eqsubst_asm_tac' ctx search_fun_asm i;
   135 fun subst_inner_asm_tac_aux i ctx = EqSubst.eqsubst_asm_tac' ctx search_fun_asm i;
   131 
   136 
   132 fun subst_outer_asm_tac ctx th =  curry (curry (FIRST' (map uncurry (map uncurry (map subst_outer_asm_tac_aux (1 upto Thm.nprems_of th)))))) ctx th;
   137 (* A tactic to substitute in the first assumption 
   133 
   138    which contains an occurence. *)
   134 fun fresh_fun_tac i thm = 
   139 
       
   140 fun subst_inner_asm_tac ctx th =  curry (curry (FIRST' (map uncurry (map uncurry (map subst_inner_asm_tac_aux (1 upto Thm.nprems_of th)))))) ctx th;
       
   141 
       
   142 fun fresh_fun_tac no_asm i thm = 
   135   (* Find the variable we instantiate *)
   143   (* Find the variable we instantiate *)
   136   let
   144   let
   137     val thy = theory_of_thm thm;
   145     val thy = theory_of_thm thm;
   138     val ctx = Context.init_proof thy;
   146     val ctx = Context.init_proof thy;
   139     val ss = simpset_of thy;
   147     val ss = simpset_of thy;
   160    in case vars' \\ vars of 
   168    in case vars' \\ vars of 
   161      [x] => Seq.single (Thm.instantiate ([],[(cterm_of thy x,cterm_of thy (list_abs (params,Bound 0)))]) st)
   169      [x] => Seq.single (Thm.instantiate ([],[(cterm_of thy x,cterm_of thy (list_abs (params,Bound 0)))]) st)
   162     | _ => error "fresh_fun_simp: Too many variables, please report."
   170     | _ => error "fresh_fun_simp: Too many variables, please report."
   163   end
   171   end
   164   in
   172   in
   165   ( (* generate_fresh_tac atom_name i      THEN *) 
   173   ((fn st =>
   166   (fn st =>
       
   167   let 
   174   let 
   168     val vars = term_vars (prop_of st);
   175     val vars = term_vars (prop_of st);
   169     val params = Logic.strip_params (nth (prems_of st) (i-1))
   176     val params = Logic.strip_params (nth (prems_of st) (i-1))
       
   177     (* The tactics which solve the subgoals generated 
       
   178        by the conditionnal rewrite rule. *)
   170     val post_rewrite_tacs =  
   179     val post_rewrite_tacs =  
   171           [rtac pt_name_inst,
   180           [rtac pt_name_inst,
   172            rtac at_name_inst,
   181            rtac at_name_inst,
   173            TRY' (SOLVEI (NominalPermeq.finite_guess_tac ss'')),
   182            TRY' (SOLVEI (NominalPermeq.finite_guess_tac ss'')),
   174            inst_fresh vars params THEN'
   183            inst_fresh vars params THEN'
   175            (TRY' (SOLVEI (NominalPermeq.fresh_guess_tac ss''))) THEN'
   184            (TRY' (SOLVEI (NominalPermeq.fresh_guess_tac ss''))) THEN'
   176            (TRY' (SOLVEI (asm_full_simp_tac ss'')))] 
   185            (TRY' (SOLVEI (asm_full_simp_tac ss'')))] 
   177   in 
   186   in 
   178    ((subst_outer_asm_tac ctx fresh_fun_app' i THENL post_rewrite_tacs) ORELSE 
   187    ((if no_asm then 
   179     (subst_outer_tac     ctx fresh_fun_app' i THENL post_rewrite_tacs)) st
   188     (subst_inner_asm_tac ctx fresh_fun_app' i THENL post_rewrite_tacs)
       
   189     else 
       
   190      no_tac) 
       
   191     ORELSE
       
   192     (subst_inner_tac     ctx fresh_fun_app' i THENL post_rewrite_tacs)) st
   180   end)) thm
   193   end)) thm
   181   
   194   
   182   end
   195   end
   183   end
   196   end
   184 
   197 
       
   198 (* syntax for options, given "(no_asm)" will give back true, without
       
   199    gives back false *)
       
   200 val options_syntax =
       
   201     (Args.parens (Args.$$$ "no_asm") >> (K true)) ||
       
   202      (Scan.succeed false);
       
   203 
   185 val setup_generate_fresh =
   204 val setup_generate_fresh =
   186   Method.goal_args_ctxt' Args.tyname (fn ctxt => generate_fresh_tac) 
   205   Method.goal_args_ctxt' Args.tyname (fn ctxt => generate_fresh_tac) 
   187 
   206 
   188 val setup_fresh_fun_simp =
   207 val setup_fresh_fun_simp =
   189   Method.no_args (Method.SIMPLE_METHOD (fresh_fun_tac 1)) 
   208   Method.simple_args options_syntax 
       
   209   (fn b => fn _ => Method.SIMPLE_METHOD (fresh_fun_tac b 1))