src/HOL/Proofs/Lambda/StrongNorm.thy
author wenzelm
Thu May 24 17:25:53 2012 +0200 (2012-05-24)
changeset 47988 e4b69e10b990
parent 44890 22f665a2e91c
child 50241 8b0fdeeefef7
permissions -rw-r--r--
tuned proofs;
wenzelm@39157
     1
(*  Title:      HOL/Proofs/Lambda/StrongNorm.thy
berghofe@14064
     2
    Author:     Stefan Berghofer
berghofe@14064
     3
    Copyright   2000 TU Muenchen
berghofe@14064
     4
*)
berghofe@14064
     5
berghofe@14064
     6
header {* Strong normalization for simply-typed lambda calculus *}
berghofe@14064
     7
haftmann@16417
     8
theory StrongNorm imports Type InductTermi begin
berghofe@14064
     9
berghofe@14064
    10
text {*
berghofe@14064
    11
Formalization by Stefan Berghofer. Partly based on a paper proof by
berghofe@14064
    12
Felix Joachimski and Ralph Matthes \cite{Matthes-Joachimski-AML}.
berghofe@14064
    13
*}
berghofe@14064
    14
berghofe@14064
    15
berghofe@14064
    16
subsection {* Properties of @{text IT} *}
berghofe@14064
    17
berghofe@22271
    18
lemma lift_IT [intro!]: "IT t \<Longrightarrow> IT (lift t i)"
wenzelm@20503
    19
  apply (induct arbitrary: i set: IT)
berghofe@14064
    20
    apply (simp (no_asm))
berghofe@14064
    21
    apply (rule conjI)
berghofe@14064
    22
     apply
berghofe@14064
    23
      (rule impI,
berghofe@14064
    24
       rule IT.Var,
berghofe@22271
    25
       erule listsp.induct,
berghofe@14064
    26
       simp (no_asm),
berghofe@14064
    27
       simp (no_asm),
berghofe@22271
    28
       rule listsp.Cons,
berghofe@14064
    29
       blast,
berghofe@14064
    30
       assumption)+
berghofe@14064
    31
     apply auto
berghofe@14064
    32
   done
berghofe@14064
    33
berghofe@22271
    34
lemma lifts_IT: "listsp IT ts \<Longrightarrow> listsp IT (map (\<lambda>t. lift t 0) ts)"
berghofe@14064
    35
  by (induct ts) auto
berghofe@14064
    36
berghofe@22271
    37
lemma subst_Var_IT: "IT r \<Longrightarrow> IT (r[Var i/j])"
wenzelm@20503
    38
  apply (induct arbitrary: i j set: IT)
berghofe@14064
    39
    txt {* Case @{term Var}: *}
berghofe@14064
    40
    apply (simp (no_asm) add: subst_Var)
berghofe@14064
    41
    apply
berghofe@14064
    42
    ((rule conjI impI)+,
berghofe@14064
    43
      rule IT.Var,
berghofe@22271
    44
      erule listsp.induct,
berghofe@14064
    45
      simp (no_asm),
berghofe@22271
    46
      simp (no_asm),
berghofe@22271
    47
      rule listsp.Cons,
berghofe@14064
    48
      fast,
berghofe@14064
    49
      assumption)+
berghofe@14064
    50
   txt {* Case @{term Lambda}: *}
berghofe@14064
    51
   apply atomize
berghofe@14064
    52
   apply simp
berghofe@14064
    53
   apply (rule IT.Lambda)
berghofe@14064
    54
   apply fast
berghofe@14064
    55
  txt {* Case @{term Beta}: *}
berghofe@14064
    56
  apply atomize
berghofe@14064
    57
  apply (simp (no_asm_use) add: subst_subst [symmetric])
berghofe@14064
    58
  apply (rule IT.Beta)
berghofe@14064
    59
   apply auto
berghofe@14064
    60
  done
berghofe@14064
    61
berghofe@22271
    62
lemma Var_IT: "IT (Var n)"
berghofe@22271
    63
  apply (subgoal_tac "IT (Var n \<degree>\<degree> [])")
berghofe@14064
    64
   apply simp
berghofe@14064
    65
  apply (rule IT.Var)
berghofe@22271
    66
  apply (rule listsp.Nil)
berghofe@14064
    67
  done
berghofe@14064
    68
berghofe@22271
    69
lemma app_Var_IT: "IT t \<Longrightarrow> IT (t \<degree> Var i)"
berghofe@14064
    70
  apply (induct set: IT)
berghofe@14064
    71
    apply (subst app_last)
berghofe@14064
    72
    apply (rule IT.Var)
berghofe@14064
    73
    apply simp
berghofe@22271
    74
    apply (rule listsp.Cons)
berghofe@14064
    75
     apply (rule Var_IT)
berghofe@22271
    76
    apply (rule listsp.Nil)
berghofe@14064
    77
   apply (rule IT.Beta [where ?ss = "[]", unfolded foldl_Nil [THEN eq_reflection]])
berghofe@14064
    78
    apply (erule subst_Var_IT)
berghofe@14064
    79
   apply (rule Var_IT)
berghofe@14064
    80
  apply (subst app_last)
berghofe@14064
    81
  apply (rule IT.Beta)
berghofe@14064
    82
   apply (subst app_last [symmetric])
berghofe@14064
    83
   apply assumption
berghofe@14064
    84
  apply assumption
berghofe@14064
    85
  done
berghofe@14064
    86
berghofe@14064
    87
berghofe@14064
    88
subsection {* Well-typed substitution preserves termination *}
berghofe@14064
    89
berghofe@14064
    90
lemma subst_type_IT:
berghofe@22271
    91
  "\<And>t e T u i. IT t \<Longrightarrow> e\<langle>i:U\<rangle> \<turnstile> t : T \<Longrightarrow>
berghofe@22271
    92
    IT u \<Longrightarrow> e \<turnstile> u : U \<Longrightarrow> IT (t[u/i])"
berghofe@14064
    93
  (is "PROP ?P U" is "\<And>t e T u i. _ \<Longrightarrow> PROP ?Q t e T u i U")
berghofe@14064
    94
proof (induct U)
berghofe@14064
    95
  fix T t
berghofe@14064
    96
  assume MI1: "\<And>T1 T2. T = T1 \<Rightarrow> T2 \<Longrightarrow> PROP ?P T1"
berghofe@14064
    97
  assume MI2: "\<And>T1 T2. T = T1 \<Rightarrow> T2 \<Longrightarrow> PROP ?P T2"
berghofe@22271
    98
  assume "IT t"
berghofe@14064
    99
  thus "\<And>e T' u i. PROP ?Q t e T' u i T"
berghofe@14064
   100
  proof induct
berghofe@14064
   101
    fix e T' u i
berghofe@22271
   102
    assume uIT: "IT u"
berghofe@14064
   103
    assume uT: "e \<turnstile> u : T"
berghofe@14064
   104
    {
berghofe@22271
   105
      case (Var rs n e_ T'_ u_ i_)
berghofe@14064
   106
      assume nT: "e\<langle>i:T\<rangle> \<turnstile> Var n \<degree>\<degree> rs : T'"
berghofe@22271
   107
      let ?ty = "\<lambda>t. \<exists>T'. e\<langle>i:T\<rangle> \<turnstile> t : T'"
berghofe@14064
   108
      let ?R = "\<lambda>t. \<forall>e T' u i.
berghofe@22271
   109
        e\<langle>i:T\<rangle> \<turnstile> t : T' \<longrightarrow> IT u \<longrightarrow> e \<turnstile> u : T \<longrightarrow> IT (t[u/i])"
berghofe@22271
   110
      show "IT ((Var n \<degree>\<degree> rs)[u/i])"
berghofe@14064
   111
      proof (cases "n = i")
berghofe@14064
   112
        case True
berghofe@14064
   113
        show ?thesis
berghofe@14064
   114
        proof (cases rs)
berghofe@14064
   115
          case Nil
berghofe@14064
   116
          with uIT True show ?thesis by simp
berghofe@14064
   117
        next
berghofe@14064
   118
          case (Cons a as)
berghofe@14064
   119
          with nT have "e\<langle>i:T\<rangle> \<turnstile> Var n \<degree> a \<degree>\<degree> as : T'" by simp
berghofe@14064
   120
          then obtain Ts
berghofe@14064
   121
              where headT: "e\<langle>i:T\<rangle> \<turnstile> Var n \<degree> a : Ts \<Rrightarrow> T'"
berghofe@14064
   122
              and argsT: "e\<langle>i:T\<rangle> \<tturnstile> as : Ts"
berghofe@14064
   123
            by (rule list_app_typeE)
berghofe@14064
   124
          from headT obtain T''
berghofe@14064
   125
              where varT: "e\<langle>i:T\<rangle> \<turnstile> Var n : T'' \<Rightarrow> Ts \<Rrightarrow> T'"
berghofe@14064
   126
              and argT: "e\<langle>i:T\<rangle> \<turnstile> a : T''"
berghofe@14064
   127
            by cases simp_all
berghofe@14064
   128
          from varT True have T: "T = T'' \<Rightarrow> Ts \<Rrightarrow> T'"
berghofe@14064
   129
            by cases auto
berghofe@14064
   130
          with uT have uT': "e \<turnstile> u : T'' \<Rightarrow> Ts \<Rrightarrow> T'" by simp
berghofe@22271
   131
          from T have "IT ((Var 0 \<degree>\<degree> map (\<lambda>t. lift t 0)
berghofe@22271
   132
            (map (\<lambda>t. t[u/i]) as))[(u \<degree> a[u/i])/0])"
berghofe@14064
   133
          proof (rule MI2)
berghofe@22271
   134
            from T have "IT ((lift u 0 \<degree> Var 0)[a[u/i]/0])"
berghofe@14064
   135
            proof (rule MI1)
wenzelm@23464
   136
              have "IT (lift u 0)" by (rule lift_IT [OF uIT])
berghofe@22271
   137
              thus "IT (lift u 0 \<degree> Var 0)" by (rule app_Var_IT)
berghofe@14064
   138
              show "e\<langle>0:T''\<rangle> \<turnstile> lift u 0 \<degree> Var 0 : Ts \<Rrightarrow> T'"
berghofe@14064
   139
              proof (rule typing.App)
berghofe@14064
   140
                show "e\<langle>0:T''\<rangle> \<turnstile> lift u 0 : T'' \<Rightarrow> Ts \<Rrightarrow> T'"
berghofe@14064
   141
                  by (rule lift_type) (rule uT')
berghofe@14064
   142
                show "e\<langle>0:T''\<rangle> \<turnstile> Var 0 : T''"
berghofe@14064
   143
                  by (rule typing.Var) simp
berghofe@14064
   144
              qed
berghofe@14064
   145
              from Var have "?R a" by cases (simp_all add: Cons)
berghofe@22271
   146
              with argT uIT uT show "IT (a[u/i])" by simp
berghofe@14064
   147
              from argT uT show "e \<turnstile> a[u/i] : T''"
berghofe@14064
   148
                by (rule subst_lemma) simp
berghofe@14064
   149
            qed
berghofe@22271
   150
            thus "IT (u \<degree> a[u/i])" by simp
berghofe@22271
   151
            from Var have "listsp ?R as"
berghofe@14064
   152
              by cases (simp_all add: Cons)
berghofe@22271
   153
            moreover from argsT have "listsp ?ty as"
berghofe@14064
   154
              by (rule lists_typings)
berghofe@22271
   155
            ultimately have "listsp (\<lambda>t. ?R t \<and> ?ty t) as"
berghofe@22271
   156
              by simp
berghofe@22271
   157
            hence "listsp IT (map (\<lambda>t. lift t 0) (map (\<lambda>t. t[u/i]) as))"
berghofe@22271
   158
              (is "listsp IT (?ls as)")
berghofe@14064
   159
            proof induct
berghofe@14064
   160
              case Nil
nipkow@44890
   161
              show ?case by fastforce
berghofe@14064
   162
            next
berghofe@14064
   163
              case (Cons b bs)
berghofe@14064
   164
              hence I: "?R b" by simp
berghofe@14064
   165
              from Cons obtain U where "e\<langle>i:T\<rangle> \<turnstile> b : U" by fast
berghofe@22271
   166
              with uT uIT I have "IT (b[u/i])" by simp
berghofe@22271
   167
              hence "IT (lift (b[u/i]) 0)" by (rule lift_IT)
berghofe@22271
   168
              hence "listsp IT (lift (b[u/i]) 0 # ?ls bs)"
berghofe@22271
   169
                by (rule listsp.Cons) (rule Cons)
berghofe@14064
   170
              thus ?case by simp
berghofe@14064
   171
            qed
berghofe@22271
   172
            thus "IT (Var 0 \<degree>\<degree> ?ls as)" by (rule IT.Var)
berghofe@14064
   173
            have "e\<langle>0:Ts \<Rrightarrow> T'\<rangle> \<turnstile> Var 0 : Ts \<Rrightarrow> T'"
berghofe@14064
   174
              by (rule typing.Var) simp
berghofe@14064
   175
            moreover from uT argsT have "e \<tturnstile> map (\<lambda>t. t[u/i]) as : Ts"
berghofe@14064
   176
              by (rule substs_lemma)
berghofe@14064
   177
            hence "e\<langle>0:Ts \<Rrightarrow> T'\<rangle> \<tturnstile> ?ls as : Ts"
berghofe@14064
   178
              by (rule lift_types)
berghofe@14064
   179
            ultimately show "e\<langle>0:Ts \<Rrightarrow> T'\<rangle> \<turnstile> Var 0 \<degree>\<degree> ?ls as : T'"
berghofe@14064
   180
              by (rule list_app_typeI)
berghofe@14064
   181
            from argT uT have "e \<turnstile> a[u/i] : T''"
berghofe@14064
   182
              by (rule subst_lemma) (rule refl)
berghofe@14064
   183
            with uT' show "e \<turnstile> u \<degree> a[u/i] : Ts \<Rrightarrow> T'"
berghofe@14064
   184
              by (rule typing.App)
berghofe@14064
   185
          qed
berghofe@14064
   186
          with Cons True show ?thesis
hoelzl@33640
   187
            by (simp add: comp_def)
berghofe@14064
   188
        qed
berghofe@14064
   189
      next
berghofe@14064
   190
        case False
berghofe@22271
   191
        from Var have "listsp ?R rs" by simp
berghofe@14064
   192
        moreover from nT obtain Ts where "e\<langle>i:T\<rangle> \<tturnstile> rs : Ts"
berghofe@14064
   193
          by (rule list_app_typeE)
berghofe@22271
   194
        hence "listsp ?ty rs" by (rule lists_typings)
berghofe@22271
   195
        ultimately have "listsp (\<lambda>t. ?R t \<and> ?ty t) rs"
berghofe@22271
   196
          by simp
berghofe@22271
   197
        hence "listsp IT (map (\<lambda>x. x[u/i]) rs)"
berghofe@14064
   198
        proof induct
berghofe@14064
   199
          case Nil
nipkow@44890
   200
          show ?case by fastforce
berghofe@14064
   201
        next
berghofe@14064
   202
          case (Cons a as)
berghofe@14064
   203
          hence I: "?R a" by simp
berghofe@14064
   204
          from Cons obtain U where "e\<langle>i:T\<rangle> \<turnstile> a : U" by fast
berghofe@22271
   205
          with uT uIT I have "IT (a[u/i])" by simp
berghofe@22271
   206
          hence "listsp IT (a[u/i] # map (\<lambda>t. t[u/i]) as)"
berghofe@22271
   207
            by (rule listsp.Cons) (rule Cons)
berghofe@14064
   208
          thus ?case by simp
berghofe@14064
   209
        qed
berghofe@14064
   210
        with False show ?thesis by (auto simp add: subst_Var)
berghofe@14064
   211
      qed
berghofe@14064
   212
    next
berghofe@14064
   213
      case (Lambda r e_ T'_ u_ i_)
berghofe@14064
   214
      assume "e\<langle>i:T\<rangle> \<turnstile> Abs r : T'"
berghofe@14064
   215
        and "\<And>e T' u i. PROP ?Q r e T' u i T"
berghofe@22271
   216
      with uIT uT show "IT (Abs r[u/i])"
nipkow@44890
   217
        by fastforce
berghofe@14064
   218
    next
berghofe@14064
   219
      case (Beta r a as e_ T'_ u_ i_)
berghofe@14064
   220
      assume T: "e\<langle>i:T\<rangle> \<turnstile> Abs r \<degree> a \<degree>\<degree> as : T'"
berghofe@14064
   221
      assume SI1: "\<And>e T' u i. PROP ?Q (r[a/0] \<degree>\<degree> as) e T' u i T"
berghofe@14064
   222
      assume SI2: "\<And>e T' u i. PROP ?Q a e T' u i T"
berghofe@22271
   223
      have "IT (Abs (r[lift u 0/Suc i]) \<degree> a[u/i] \<degree>\<degree> map (\<lambda>t. t[u/i]) as)"
berghofe@14064
   224
      proof (rule IT.Beta)
berghofe@14064
   225
        have "Abs r \<degree> a \<degree>\<degree> as \<rightarrow>\<^sub>\<beta> r[a/0] \<degree>\<degree> as"
berghofe@14064
   226
          by (rule apps_preserves_beta) (rule beta.beta)
berghofe@14064
   227
        with T have "e\<langle>i:T\<rangle> \<turnstile> r[a/0] \<degree>\<degree> as : T'"
berghofe@14064
   228
          by (rule subject_reduction)
berghofe@22271
   229
        hence "IT ((r[a/0] \<degree>\<degree> as)[u/i])"
wenzelm@32960
   230
          using uIT uT by (rule SI1)
berghofe@22271
   231
        thus "IT (r[lift u 0/Suc i][a[u/i]/0] \<degree>\<degree> map (\<lambda>t. t[u/i]) as)"
berghofe@14064
   232
          by (simp del: subst_map add: subst_subst subst_map [symmetric])
berghofe@14064
   233
        from T obtain U where "e\<langle>i:T\<rangle> \<turnstile> Abs r \<degree> a : U"
berghofe@14064
   234
          by (rule list_app_typeE) fast
berghofe@14064
   235
        then obtain T'' where "e\<langle>i:T\<rangle> \<turnstile> a : T''" by cases simp_all
wenzelm@23464
   236
        thus "IT (a[u/i])" using uIT uT by (rule SI2)
berghofe@14064
   237
      qed
berghofe@22271
   238
      thus "IT ((Abs r \<degree> a \<degree>\<degree> as)[u/i])" by simp
berghofe@14064
   239
    }
berghofe@14064
   240
  qed
berghofe@14064
   241
qed
berghofe@14064
   242
berghofe@14064
   243
berghofe@14064
   244
subsection {* Well-typed terms are strongly normalizing *}
berghofe@14064
   245
wenzelm@18257
   246
lemma type_implies_IT:
wenzelm@18257
   247
  assumes "e \<turnstile> t : T"
berghofe@22271
   248
  shows "IT t"
wenzelm@23464
   249
  using assms
wenzelm@18257
   250
proof induct
wenzelm@18257
   251
  case Var
wenzelm@18257
   252
  show ?case by (rule Var_IT)
wenzelm@18257
   253
next
wenzelm@18257
   254
  case Abs
wenzelm@23464
   255
  show ?case by (rule IT.Lambda) (rule Abs)
wenzelm@18257
   256
next
berghofe@22271
   257
  case (App e s T U t)
berghofe@22271
   258
  have "IT ((Var 0 \<degree> lift t 0)[s/0])"
wenzelm@18257
   259
  proof (rule subst_type_IT)
wenzelm@23464
   260
    have "IT (lift t 0)" using `IT t` by (rule lift_IT)
berghofe@22271
   261
    hence "listsp IT [lift t 0]" by (rule listsp.Cons) (rule listsp.Nil)
berghofe@22271
   262
    hence "IT (Var 0 \<degree>\<degree> [lift t 0])" by (rule IT.Var)
wenzelm@18257
   263
    also have "Var 0 \<degree>\<degree> [lift t 0] = Var 0 \<degree> lift t 0" by simp
berghofe@22271
   264
    finally show "IT \<dots>" .
wenzelm@18257
   265
    have "e\<langle>0:T \<Rightarrow> U\<rangle> \<turnstile> Var 0 : T \<Rightarrow> U"
wenzelm@18257
   266
      by (rule typing.Var) simp
wenzelm@18257
   267
    moreover have "e\<langle>0:T \<Rightarrow> U\<rangle> \<turnstile> lift t 0 : T"
wenzelm@23464
   268
      by (rule lift_type) (rule App.hyps)
wenzelm@18257
   269
    ultimately show "e\<langle>0:T \<Rightarrow> U\<rangle> \<turnstile> Var 0 \<degree> lift t 0 : U"
wenzelm@18257
   270
      by (rule typing.App)
wenzelm@23464
   271
    show "IT s" by fact
wenzelm@23464
   272
    show "e \<turnstile> s : T \<Rightarrow> U" by fact
berghofe@14064
   273
  qed
wenzelm@18257
   274
  thus ?case by simp
berghofe@14064
   275
qed
berghofe@14064
   276
berghofe@23750
   277
theorem type_implies_termi: "e \<turnstile> t : T \<Longrightarrow> termip beta t"
berghofe@14064
   278
proof -
berghofe@14064
   279
  assume "e \<turnstile> t : T"
berghofe@22271
   280
  hence "IT t" by (rule type_implies_IT)
berghofe@14064
   281
  thus ?thesis by (rule IT_implies_termi)
berghofe@14064
   282
qed
berghofe@14064
   283
berghofe@14064
   284
end