| 
5261
 | 
     1  | 
(*  Title:      HOL/Lambda/ListBeta.ML
  | 
| 
 | 
     2  | 
    ID:         $Id$
  | 
| 
 | 
     3  | 
    Author:     Tobias Nipkow
  | 
| 
 | 
     4  | 
    Copyright   1998 TU Muenchen
  | 
| 
 | 
     5  | 
*)
  | 
| 
 | 
     6  | 
  | 
| 
 | 
     7  | 
Goal
  | 
| 
 | 
     8  | 
 "v -> v' ==> !rs. v = (Var n)$$rs --> (? ss. rs => ss & v' = (Var n)$$ss)";
  | 
| 
5326
 | 
     9  | 
by (etac beta.induct 1);
  | 
| 
5525
 | 
    10  | 
   by (Asm_full_simp_tac 1);
  | 
| 
 | 
    11  | 
  by (rtac allI 1);
  | 
| 
 | 
    12  | 
  by (res_inst_tac [("xs","rs")] rev_exhaust 1);
 | 
| 
 | 
    13  | 
   by (Asm_full_simp_tac 1);
  | 
| 
 | 
    14  | 
  by (force_tac (claset() addIs [append_step1I],simpset()) 1);
  | 
| 
 | 
    15  | 
 by (rtac allI 1);
  | 
| 
 | 
    16  | 
 by (res_inst_tac [("xs","rs")] rev_exhaust 1);
 | 
| 
 | 
    17  | 
  by (Asm_full_simp_tac 1);
  | 
| 
 | 
    18  | 
 by (mk_auto_tac (claset() addIs [disjI2 RS append_step1I],simpset()) 0 3);
  | 
| 
5261
 | 
    19  | 
val lemma = result();
  | 
| 
 | 
    20  | 
  | 
| 
 | 
    21  | 
Goal "(Var n)$$rs -> v ==> (? ss. rs => ss & v = (Var n)$$ss)";
  | 
| 
5318
 | 
    22  | 
by (dtac lemma 1);
  | 
| 
 | 
    23  | 
by (Blast_tac 1);
  | 
| 
5261
 | 
    24  | 
qed "head_Var_reduction";
  | 
| 
 | 
    25  | 
  | 
| 
 | 
    26  | 
Goal "u -> u' ==> !r rs. u = r$$rs --> \
  | 
| 
 | 
    27  | 
\     ( (? r'. r -> r' & u' = r'$$rs) | \
  | 
| 
 | 
    28  | 
\       (? rs'. rs => rs' & u' = r$$rs') | \
  | 
| 
 | 
    29  | 
\       (? s t ts. r = Abs s & rs = t#ts & u' = s[t/0]$$ts))";
  | 
| 
5326
 | 
    30  | 
by (etac beta.induct 1);
  | 
| 
5318
 | 
    31  | 
   by (clarify_tac (claset() delrules [disjCI]) 1);
  | 
| 
 | 
    32  | 
   by (exhaust_tac "r" 1);
  | 
| 
 | 
    33  | 
     by (Asm_full_simp_tac 1);
  | 
| 
 | 
    34  | 
    by (asm_full_simp_tac (simpset() addsimps [App_eq_foldl_conv]) 1);
  | 
| 
 | 
    35  | 
    by (split_asm_tac [split_if_asm] 1);
  | 
| 
 | 
    36  | 
     by (Asm_full_simp_tac 1);
  | 
| 
 | 
    37  | 
     by (Blast_tac 1);
  | 
| 
 | 
    38  | 
    by (Asm_full_simp_tac 1);
  | 
| 
 | 
    39  | 
   by (asm_full_simp_tac (simpset() addsimps [App_eq_foldl_conv]) 1);
  | 
| 
 | 
    40  | 
   by (split_asm_tac [split_if_asm] 1);
  | 
| 
 | 
    41  | 
    by (Asm_full_simp_tac 1);
  | 
| 
 | 
    42  | 
   by (Asm_full_simp_tac 1);
  | 
| 
 | 
    43  | 
  by (clarify_tac (claset() delrules [disjCI]) 1);
  | 
| 
 | 
    44  | 
  by (dtac (App_eq_foldl_conv RS iffD1) 1);
  | 
| 
 | 
    45  | 
  by (split_asm_tac [split_if_asm] 1);
  | 
| 
 | 
    46  | 
   by (Asm_full_simp_tac 1);
  | 
| 
 | 
    47  | 
   by (Blast_tac 1);
  | 
| 
 | 
    48  | 
  by (force_tac (claset() addIs [disjI1 RS append_step1I],simpset()) 1);
  | 
| 
 | 
    49  | 
 by (clarify_tac (claset() delrules [disjCI]) 1);
  | 
| 
 | 
    50  | 
 by (dtac (App_eq_foldl_conv RS iffD1) 1);
  | 
| 
 | 
    51  | 
 by (split_asm_tac [split_if_asm] 1);
  | 
| 
 | 
    52  | 
  by (Asm_full_simp_tac 1);
  | 
| 
 | 
    53  | 
  by (Blast_tac 1);
  | 
| 
5525
 | 
    54  | 
 by (mk_auto_tac (claset() addIs [disjI2 RS append_step1I],simpset()) 0 3);
  | 
| 
5261
 | 
    55  | 
val lemma = result();
  | 
| 
 | 
    56  | 
  | 
| 
5455
 | 
    57  | 
val major::prems =
  | 
| 
 | 
    58  | 
Goal "[| r $$ rs -> s; !!r'. [| r -> r'; s = r' $$ rs |] ==> R;   \
  | 
| 
 | 
    59  | 
\        !!rs'. [| rs => rs'; s = r $$ rs' |] ==> R;              \
  | 
| 
 | 
    60  | 
\        !!t u us. [| r = Abs t; rs = u # us; s = t[u/0] $$ us |] ==> R |]   \
  | 
| 
 | 
    61  | 
\     ==> R";
  | 
| 
 | 
    62  | 
by (cut_facts_tac [major RS lemma RS spec RS spec] 1);
  | 
| 
 | 
    63  | 
by (REPEAT_FIRST (ares_tac [refl] ORELSE'
  | 
| 
 | 
    64  | 
		  eresolve_tac (prems @ [exE, conjE, impE, disjE])));
  | 
| 
 | 
    65  | 
qed "apps_betasE";
  | 
| 
5261
 | 
    66  | 
AddSEs [apps_betasE];
  | 
| 
 | 
    67  | 
  | 
| 
 | 
    68  | 
Goal "r -> s ==> r$$ss -> s$$ss";
  | 
| 
5318
 | 
    69  | 
by (res_inst_tac [("xs","ss")] rev_induct 1);
 | 
| 
 | 
    70  | 
by (Auto_tac);
  | 
| 
5261
 | 
    71  | 
qed "apps_preserves_beta";
  | 
| 
 | 
    72  | 
Addsimps [apps_preserves_beta];
  | 
| 
 | 
    73  | 
  | 
| 
 | 
    74  | 
Goal "r ->> s ==> r$$ss ->> s$$ss";
  | 
| 
5318
 | 
    75  | 
by (etac rtrancl_induct 1);
  | 
| 
 | 
    76  | 
 by (Blast_tac 1);
  | 
| 
 | 
    77  | 
by (blast_tac (claset() addIs [apps_preserves_beta,rtrancl_into_rtrancl]) 1);
  | 
| 
5261
 | 
    78  | 
qed "apps_preserves_beta2";
  | 
| 
 | 
    79  | 
Addsimps [apps_preserves_beta2];
  | 
| 
 | 
    80  | 
  | 
| 
 | 
    81  | 
Goal "!ss. rs => ss --> r$$rs -> r$$ss";
  | 
| 
5318
 | 
    82  | 
by (res_inst_tac [("xs","rs")] rev_induct 1);
 | 
| 
 | 
    83  | 
 by (Asm_full_simp_tac 1);
  | 
| 
 | 
    84  | 
by (Asm_full_simp_tac 1);
  | 
| 
 | 
    85  | 
by (Clarify_tac 1);
  | 
| 
 | 
    86  | 
by (res_inst_tac [("xs","ss")] rev_exhaust 1);
 | 
| 
 | 
    87  | 
 by (Asm_full_simp_tac 1);
  | 
| 
 | 
    88  | 
by (Asm_full_simp_tac 1);
  | 
| 
 | 
    89  | 
by (dtac Snoc_step1_SnocD 1);
  | 
| 
 | 
    90  | 
by (Blast_tac 1);
  | 
| 
5261
 | 
    91  | 
qed_spec_mp "apps_preserves_betas";
  | 
| 
 | 
    92  | 
Addsimps [apps_preserves_betas];
  |