src/HOL/Lambda/Lambda.ML
author paulson
Thu, 26 Sep 1996 12:47:47 +0200
changeset 2031 03a843f0f447
parent 1974 b50f96543dec
child 2116 73bbf2cc7651
permissions -rw-r--r--
Ran expandshort
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
     1
(*  Title:      HOL/Lambda/Lambda.ML
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
     2
    ID:         $Id$
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
     3
    Author:     Tobias Nipkow
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
     4
    Copyright   1995 TU Muenchen
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
     5
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
     6
Substitution-lemmas.  Most of the proofs, esp. those about natural numbers,
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
     7
are ported from Ole Rasmussen's ZF development.  In ZF, m<=n is syntactic
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
     8
sugar for m<Suc(n). In HOL <= is a separate operator. Hence we have to prove
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
     9
some compatibility lemmas.
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    10
*)
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    11
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    12
(*** Nat ***)
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    13
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    14
goal Nat.thy "!!i. [| i < Suc j; j < k |] ==> i < k";
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
    15
by (rtac le_less_trans 1);
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
    16
by (assume_tac 2);
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
    17
by (asm_full_simp_tac (!simpset addsimps [le_def, less_Suc_eq]) 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
    18
by (fast_tac (HOL_cs addEs [less_asym,less_irrefl]) 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    19
qed "lt_trans1";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    20
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    21
goal Nat.thy "!!i. [| i < j; j < Suc(k) |] ==> i < k";
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
    22
by (etac less_le_trans 1);
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
    23
by (asm_full_simp_tac (!simpset addsimps [le_def, less_Suc_eq]) 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
    24
by (fast_tac (HOL_cs addEs [less_asym,less_irrefl]) 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    25
qed "lt_trans2";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    26
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    27
val major::prems = goal Nat.thy
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    28
  "[| i < Suc j; i < j ==> P; i = j ==> P |] ==> P";
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
    29
by (rtac (major RS lessE) 1);
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
    30
by (ALLGOALS Asm_full_simp_tac);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
    31
by (resolve_tac prems 1 THEN etac sym 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
    32
by (fast_tac (HOL_cs addIs prems) 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    33
qed "leqE";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    34
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    35
goal Arith.thy "!!i. Suc i < j ==> i < pred j ";
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
    36
by (rtac Suc_less_SucD 1);
1302
ddfdcc9ce667 Moved some thms to Arith and to Trancl.
nipkow
parents: 1288
diff changeset
    37
by (Asm_simp_tac 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    38
qed "lt_pred";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    39
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    40
goal Arith.thy "!!i. [| i < Suc j; k < i |] ==> pred i < j ";
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
    41
by (rtac Suc_less_SucD 1);
1302
ddfdcc9ce667 Moved some thms to Arith and to Trancl.
nipkow
parents: 1288
diff changeset
    42
by (Asm_simp_tac 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    43
qed "gt_pred";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    44
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
    45
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    46
(*** Lambda ***)
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    47
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    48
open Lambda;
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    49
1974
b50f96543dec Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents: 1759
diff changeset
    50
Delsimps [subst_Var];
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
    51
Addsimps ([if_not_P, not_less_eq] @ beta.intrs);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    52
1302
ddfdcc9ce667 Moved some thms to Arith and to Trancl.
nipkow
parents: 1288
diff changeset
    53
(* don't add r_into_rtrancl! *)
1974
b50f96543dec Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents: 1759
diff changeset
    54
AddSIs beta.intrs;
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    55
1759
a42d6c537f4a Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents: 1723
diff changeset
    56
val db_case_distinction =
a42d6c537f4a Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents: 1723
diff changeset
    57
  rule_by_tactic(EVERY[etac thin_rl 2,etac thin_rl 2,etac thin_rl 3])db.induct;
a42d6c537f4a Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents: 1723
diff changeset
    58
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    59
(*** Congruence rules for ->> ***)
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    60
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    61
goal Lambda.thy "!!s. s ->> s' ==> Fun s ->> Fun s'";
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
    62
by (etac rtrancl_induct 1);
1974
b50f96543dec Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents: 1759
diff changeset
    63
by (ALLGOALS(fast_tac (!claset addIs [rtrancl_into_rtrancl])));
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    64
qed "rtrancl_beta_Fun";
1974
b50f96543dec Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents: 1759
diff changeset
    65
AddSIs [rtrancl_beta_Fun];
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    66
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    67
goal Lambda.thy "!!s. s ->> s' ==> s @ t ->> s' @ t";
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
    68
by (etac rtrancl_induct 1);
1974
b50f96543dec Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents: 1759
diff changeset
    69
by (ALLGOALS(fast_tac (!claset addIs [rtrancl_into_rtrancl])));
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    70
qed "rtrancl_beta_AppL";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    71
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    72
goal Lambda.thy "!!s. t ->> t' ==> s @ t ->> s @ t'";
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
    73
by (etac rtrancl_induct 1);
1974
b50f96543dec Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents: 1759
diff changeset
    74
by (ALLGOALS(fast_tac (!claset addIs [rtrancl_into_rtrancl])));
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    75
qed "rtrancl_beta_AppR";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    76
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    77
goal Lambda.thy "!!s. [| s ->> s'; t ->> t' |] ==> s @ t ->> s' @ t'";
1974
b50f96543dec Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents: 1759
diff changeset
    78
by (deepen_tac (!claset addSIs [rtrancl_beta_AppL,rtrancl_beta_AppR]
b50f96543dec Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents: 1759
diff changeset
    79
                        addIs  [rtrancl_trans]) 3 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    80
qed "rtrancl_beta_App";
1974
b50f96543dec Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents: 1759
diff changeset
    81
AddIs [rtrancl_beta_App];
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    82
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    83
(*** subst and lift ***)
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    84
1723
286f9b6370ab Replaced split_tac by split_inside_tac.
berghofe
parents: 1673
diff changeset
    85
fun addsplit ss = ss addsimps [subst_Var] setloop (split_inside_tac [expand_if]);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    86
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
    87
goal Lambda.thy "(Var k)[u/k] = u";
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
    88
by (asm_full_simp_tac(addsplit(!simpset)) 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    89
qed "subst_eq";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    90
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
    91
goal Lambda.thy "!!s. i<j ==> (Var j)[u/i] = Var(pred j)";
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
    92
by (asm_full_simp_tac(addsplit(!simpset)) 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    93
qed "subst_gt";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    94
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
    95
goal Lambda.thy "!!s. j<i ==> (Var j)[u/i] = Var(j)";
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
    96
by (asm_full_simp_tac (addsplit(!simpset) addsimps
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    97
                          [less_not_refl2 RS not_sym,less_SucI]) 1);
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    98
qed "subst_lt";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
    99
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   100
Addsimps [subst_eq,subst_gt,subst_lt];
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   101
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   102
goal Lambda.thy
1172
ab725b698cb2 Renamed some vars.
nipkow
parents: 1153
diff changeset
   103
  "!i k. i < Suc k --> lift (lift t i) (Suc k) = lift (lift t k) i";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   104
by (db.induct_tac "t" 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   105
by (ALLGOALS Asm_simp_tac);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   106
by (strip_tac 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   107
by (excluded_middle_tac "nat < i" 1);
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   108
by ((forward_tac [lt_trans2] 2) THEN (assume_tac 2));
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
   109
by (ALLGOALS(asm_full_simp_tac (addsplit(!simpset) addsimps [less_SucI])));
1486
7b95d7b49f7a Introduced qed_spec_mp.
nipkow
parents: 1465
diff changeset
   110
qed_spec_mp "lift_lift";
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   111
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   112
goal Lambda.thy "!i j s. j < Suc i --> \
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   113
\         lift (t[s/j]) i = (lift t (Suc i)) [lift s i / j]";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   114
by (db.induct_tac "t" 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   115
by (ALLGOALS(asm_simp_tac (!simpset addsimps [lift_lift])));
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   116
by (strip_tac 1);
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   117
by (excluded_middle_tac "nat < j" 1);
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
   118
by (Asm_full_simp_tac 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   119
by (eres_inst_tac [("j","nat")] leqE 1);
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
   120
by (asm_full_simp_tac (addsplit(!simpset)
1302
ddfdcc9ce667 Moved some thms to Arith and to Trancl.
nipkow
parents: 1288
diff changeset
   121
                       addsimps [less_SucI,gt_pred]) 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   122
by (hyp_subst_tac 1);
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   123
by (Asm_simp_tac 1);
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   124
by (forw_inst_tac [("j","j")] lt_trans2 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   125
by (assume_tac 1);
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
   126
by (asm_full_simp_tac (addsplit(!simpset) addsimps [less_SucI]) 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   127
qed "lift_subst";
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   128
Addsimps [lift_subst];
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   129
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   130
goal Lambda.thy
1172
ab725b698cb2 Renamed some vars.
nipkow
parents: 1153
diff changeset
   131
  "!i j s. i < Suc j -->\
ab725b698cb2 Renamed some vars.
nipkow
parents: 1153
diff changeset
   132
\         lift (t[s/j]) i = (lift t i) [lift s i / Suc j]";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   133
by (db.induct_tac "t" 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   134
by (ALLGOALS(asm_simp_tac (!simpset addsimps [lift_lift])));
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   135
by (strip_tac 1);
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   136
by (excluded_middle_tac "nat < j" 1);
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
   137
by (Asm_full_simp_tac 1);
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   138
by (eres_inst_tac [("i","j")] leqE 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   139
by (forward_tac  [lt_trans1] 1 THEN assume_tac 1);
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
   140
by (ALLGOALS(asm_full_simp_tac
1302
ddfdcc9ce667 Moved some thms to Arith and to Trancl.
nipkow
parents: 1288
diff changeset
   141
               (!simpset addsimps [less_SucI,gt_pred])));
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   142
by (hyp_subst_tac 1);
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
   143
by (asm_full_simp_tac (!simpset addsimps [less_SucI]) 1);
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   144
by (split_tac [expand_if] 1);
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   145
by (asm_full_simp_tac (!simpset addsimps [less_SucI]) 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   146
qed "lift_subst_lt";
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   147
1172
ab725b698cb2 Renamed some vars.
nipkow
parents: 1153
diff changeset
   148
goal Lambda.thy "!k s. (lift t k)[s/k] = t";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   149
by (db.induct_tac "t" 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   150
by (ALLGOALS Asm_simp_tac);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   151
by (split_tac [expand_if] 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   152
by (ALLGOALS Asm_full_simp_tac);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   153
qed "subst_lift";
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   154
Addsimps [subst_lift];
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   155
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   156
1172
ab725b698cb2 Renamed some vars.
nipkow
parents: 1153
diff changeset
   157
goal Lambda.thy "!i j u v. i < Suc j --> \
ab725b698cb2 Renamed some vars.
nipkow
parents: 1153
diff changeset
   158
\ t[lift v i / Suc j][u[v/j]/i] = t[u/i][v/j]";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   159
by (db.induct_tac "t" 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   160
by (ALLGOALS(asm_simp_tac(!simpset addsimps [lift_lift RS sym,lift_subst_lt])));
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   161
by (strip_tac 1);
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   162
by (excluded_middle_tac "nat < Suc(Suc j)" 1);
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   163
by (Asm_full_simp_tac 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   164
by (forward_tac [lessI RS less_trans] 1);
1465
5d7a7e439cec expanded tabs
clasohm
parents: 1302
diff changeset
   165
by (etac leqE 1);
1302
ddfdcc9ce667 Moved some thms to Arith and to Trancl.
nipkow
parents: 1288
diff changeset
   166
by (asm_simp_tac (!simpset addsimps [lt_pred]) 2);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   167
by (forward_tac [Suc_mono RS less_trans] 1 THEN assume_tac 1);
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   168
by (forw_inst_tac [("i","i")] (lessI RS less_trans) 1);
1302
ddfdcc9ce667 Moved some thms to Arith and to Trancl.
nipkow
parents: 1288
diff changeset
   169
by (asm_simp_tac (!simpset addsimps [lt_pred]) 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   170
by (eres_inst_tac [("i","nat")] leqE 1);
1302
ddfdcc9ce667 Moved some thms to Arith and to Trancl.
nipkow
parents: 1288
diff changeset
   171
by (asm_full_simp_tac (!simpset addsimps [less_SucI]) 2);
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   172
by (excluded_middle_tac "nat < i" 1);
1269
ee011b365770 New version with eta reduction.
nipkow
parents: 1266
diff changeset
   173
by (Asm_full_simp_tac 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   174
by (eres_inst_tac [("j","nat")] leqE 1);
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   175
by (asm_simp_tac (!simpset addsimps [gt_pred]) 1);
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   176
by (Asm_simp_tac 1);
1120
ff7dd80513e6 Lambda calculus in de Bruijn notation.
nipkow
parents:
diff changeset
   177
by (forward_tac [lt_trans2] 1 THEN assume_tac 1);
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   178
by (asm_simp_tac (!simpset addsimps [gt_pred]) 1);
1486
7b95d7b49f7a Introduced qed_spec_mp.
nipkow
parents: 1465
diff changeset
   179
qed_spec_mp "subst_subst";
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   180
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   181
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   182
(*** Equivalence proof for optimized substitution ***)
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   183
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   184
goal Lambda.thy "!k. liftn 0 t k = t";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   185
by (db.induct_tac "t" 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   186
by (ALLGOALS(asm_simp_tac(addsplit(!simpset))));
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   187
qed "liftn_0";
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   188
Addsimps [liftn_0];
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   189
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   190
goal Lambda.thy "!k. liftn (Suc n) t k = lift (liftn n t k) k";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   191
by (db.induct_tac "t" 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   192
by (ALLGOALS(asm_simp_tac(addsplit(!simpset))));
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   193
by (fast_tac (HOL_cs addDs [add_lessD1]) 1);
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   194
qed "liftn_lift";
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   195
Addsimps [liftn_lift];
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   196
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   197
goal Lambda.thy "!n. substn t s n = t[liftn n s 0 / n]";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   198
by (db.induct_tac "t" 1);
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   199
by (ALLGOALS(asm_simp_tac(addsplit(!simpset))));
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   200
qed "substn_subst_n";
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1172
diff changeset
   201
Addsimps [substn_subst_n];
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   202
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   203
goal Lambda.thy "substn t s 0 = t[s/0]";
2031
03a843f0f447 Ran expandshort
paulson
parents: 1974
diff changeset
   204
by (Simp_tac 1);
1153
5c5daf97cf2d Simplified the confluence proofs.
nipkow
parents: 1124
diff changeset
   205
qed "substn_subst_0";