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