| 5276 |      1 | (*  Title:      HOL/Lambda/InductTermi.ML
 | 
|  |      2 |     ID:         $Id$
 | 
|  |      3 |     Author:     Tobias Nipkow
 | 
|  |      4 |     Copyright   1998 TU Muenchen
 | 
|  |      5 | *)
 | 
|  |      6 | 
 | 
| 5261 |      7 | (*** Every term in IT terminates ***)
 | 
|  |      8 | 
 | 
|  |      9 | Goal "s : termi beta ==> !t. t : termi beta --> \
 | 
|  |     10 | \     (!r ss. t = r[s/0]$$ss --> Abs r $ s $$ ss : termi beta)";
 | 
| 5318 |     11 | by (etac acc_induct 1);
 | 
|  |     12 | by (etac thin_rl 1);
 | 
|  |     13 | by (rtac allI 1);
 | 
|  |     14 | by (rtac impI 1);
 | 
|  |     15 | by (etac acc_induct 1);
 | 
|  |     16 | by (Clarify_tac 1);
 | 
|  |     17 | by (rtac accI 1);
 | 
|  |     18 | by (safe_tac (claset() addSEs [apps_betasE]));
 | 
|  |     19 |    by (assume_tac 1);
 | 
|  |     20 |   by (blast_tac (claset() addIs [subst_preserves_beta,apps_preserves_beta]) 1);
 | 
|  |     21 |  by (blast_tac (claset()
 | 
| 5261 |     22 |     addIs [apps_preserves_beta2,subst_preserves_beta2,rtrancl_converseI]
 | 
|  |     23 |     addDs [acc_downwards]) 1);
 | 
|  |     24 | (* FIXME: acc_downwards can be replaced by acc(R ^* ) = acc(r) *)
 | 
| 5318 |     25 | by (blast_tac (claset() addDs [apps_preserves_betas]) 1);
 | 
| 5261 |     26 | qed_spec_mp "double_induction_lemma";
 | 
|  |     27 | 
 | 
|  |     28 | Goal "t : IT ==> t : termi(beta)";
 | 
| 5326 |     29 | by (etac IT.induct 1);
 | 
| 5318 |     30 |   by (dtac rev_subsetD 1);
 | 
|  |     31 |    by (rtac lists_mono 1);
 | 
|  |     32 |    by (rtac Int_lower2 1);
 | 
|  |     33 |   by (Asm_full_simp_tac 1);
 | 
|  |     34 |   by (dtac lists_accD 1);
 | 
|  |     35 |   by (etac acc_induct 1);
 | 
|  |     36 |   by (rtac accI 1);
 | 
|  |     37 |   by (blast_tac (claset() addSDs [head_Var_reduction]) 1);
 | 
|  |     38 |  by (etac acc_induct 1);
 | 
|  |     39 |  by (rtac accI 1);
 | 
|  |     40 |  by (Blast_tac 1);
 | 
|  |     41 | by (blast_tac (claset() addIs [double_induction_lemma]) 1);
 | 
| 5261 |     42 | qed "IT_implies_termi";
 | 
|  |     43 | 
 | 
|  |     44 | (*** Every terminating term is in IT ***)
 | 
|  |     45 | 
 | 
| 6141 |     46 | Addsimps [Var_apps_neq_Abs_apps RS not_sym];
 | 
|  |     47 | 
 | 
|  |     48 | Goal "Var n $$ ss ~= Abs r $ s $$ ts";
 | 
|  |     49 | by (simp_tac (simpset() addsimps [foldl_Cons RS sym] 
 | 
|  |     50 | 	                delsimps [foldl_Cons]) 1);
 | 
|  |     51 | qed "Var_apps_neq_Abs_app_apps";
 | 
|  |     52 | Addsimps [Var_apps_neq_Abs_app_apps,
 | 
|  |     53 | 	  Var_apps_neq_Abs_app_apps RS not_sym];
 | 
|  |     54 | 
 | 
|  |     55 | 
 | 
|  |     56 | Goal "(Abs r $ s $$ ss = Abs r' $ s' $$ ss') = (r=r' & s=s' & ss=ss')";
 | 
|  |     57 | by (simp_tac (simpset() addsimps [foldl_Cons RS sym] 
 | 
|  |     58 | 	                delsimps [foldl_Cons]) 1);
 | 
|  |     59 | qed "Abs_apps_eq_Abs_app_apps";
 | 
|  |     60 | Addsimps [Abs_apps_eq_Abs_app_apps];
 | 
|  |     61 | 
 | 
|  |     62 | val IT_cases = 
 | 
|  |     63 |     map IT.mk_cases
 | 
|  |     64 |         ["Var n $$ ss : IT", "Abs t : IT", "Abs r $ s $$ ts : IT"];
 | 
| 5261 |     65 | AddSEs IT_cases;
 | 
|  |     66 | 
 | 
|  |     67 | 
 | 
|  |     68 | Goal "r : termi beta ==> r : IT";
 | 
| 5318 |     69 | by (etac acc_induct 1);
 | 
|  |     70 | by (rename_tac "r" 1);
 | 
|  |     71 | by (etac thin_rl 1);
 | 
|  |     72 | by (etac rev_mp 1);
 | 
|  |     73 | by (Simp_tac 1);
 | 
|  |     74 | by (res_inst_tac [("t","r")] Apps_dB_induct 1);
 | 
|  |     75 |  by (rename_tac "n ts" 1);
 | 
|  |     76 |  by (Clarify_tac 1);
 | 
| 5326 |     77 |  by (resolve_tac IT.intrs 1);
 | 
| 5318 |     78 |  by (Clarify_tac 1);
 | 
|  |     79 |  by (EVERY1[dtac bspec, atac]);
 | 
|  |     80 |  by (etac mp 1);
 | 
|  |     81 |   by (Clarify_tac 1);
 | 
|  |     82 |   by (dtac converseI 1);
 | 
|  |     83 |   by (EVERY1[dtac ex_step1I, atac]);
 | 
|  |     84 |   by (Clarify_tac 1);
 | 
|  |     85 |   by (rename_tac "us" 1);
 | 
|  |     86 |   by (eres_inst_tac [("x","Var n $$ us")] allE 1);
 | 
|  |     87 |   by (Force_tac 1);
 | 
|  |     88 | by (rename_tac "u ts" 1);
 | 
|  |     89 | by (exhaust_tac "ts" 1);
 | 
|  |     90 |  by (Asm_full_simp_tac 1);
 | 
|  |     91 |  by (blast_tac (claset() addIs IT.intrs) 1);
 | 
|  |     92 | by (rename_tac "s ss" 1);
 | 
|  |     93 | by (Asm_full_simp_tac 1);
 | 
|  |     94 | by (Clarify_tac 1);
 | 
| 5326 |     95 | by (resolve_tac IT.intrs 1);
 | 
| 5318 |     96 |  by (blast_tac (claset() addIs [apps_preserves_beta]) 1);
 | 
|  |     97 | by (etac mp 1);
 | 
|  |     98 |  by (Clarify_tac 1);
 | 
|  |     99 |  by (rename_tac "t" 1);
 | 
|  |    100 |  by (eres_inst_tac [("x","Abs u $ t $$ ss")] allE 1);
 | 
|  |    101 |  by (Force_tac 1);
 | 
| 5261 |    102 | qed "termi_implies_IT";
 |