src/LCF/LCF.thy
author wenzelm
Tue Aug 12 21:29:50 2014 +0200 (2014-08-12)
changeset 57920 c1953856cfca
parent 55380 4de48353034e
child 58889 5b7a9633cfa8
permissions -rw-r--r--
clarified focus and key handling -- more like SideKick;
avoid resetting input map with its potentially confusion propagation of key events to unrelated components, e.g. main text area or tree scrollbar;
wenzelm@19757
     1
(*  Title:      LCF/LCF.thy
clasohm@1474
     2
    Author:     Tobias Nipkow
clasohm@0
     3
    Copyright   1992  University of Cambridge
clasohm@0
     4
*)
clasohm@0
     5
wenzelm@17248
     6
header {* LCF on top of First-Order Logic *}
clasohm@0
     7
wenzelm@17248
     8
theory LCF
wenzelm@48475
     9
imports "~~/src/FOL/FOL"
wenzelm@17248
    10
begin
clasohm@0
    11
wenzelm@17248
    12
text {* This theory is based on Lawrence Paulson's book Logic and Computation. *}
clasohm@0
    13
wenzelm@17248
    14
subsection {* Natural Deduction Rules for LCF *}
wenzelm@17248
    15
wenzelm@55380
    16
class cpo = "term"
wenzelm@36452
    17
default_sort cpo
wenzelm@17248
    18
wenzelm@17248
    19
typedecl tr
wenzelm@17248
    20
typedecl void
wenzelm@41310
    21
typedecl ('a,'b) prod  (infixl "*" 6)
wenzelm@41310
    22
typedecl ('a,'b) sum  (infixl "+" 5)
clasohm@0
    23
wenzelm@55380
    24
instance "fun" :: (cpo, cpo) cpo ..
wenzelm@55380
    25
instance prod :: (cpo, cpo) cpo ..
wenzelm@55380
    26
instance sum :: (cpo, cpo) cpo ..
wenzelm@55380
    27
instance tr :: cpo ..
wenzelm@55380
    28
instance void :: cpo ..
clasohm@0
    29
clasohm@0
    30
consts
clasohm@1474
    31
 UU     :: "'a"
wenzelm@17248
    32
 TT     :: "tr"
wenzelm@17248
    33
 FF     :: "tr"
clasohm@1474
    34
 FIX    :: "('a => 'a) => 'a"
clasohm@1474
    35
 FST    :: "'a*'b => 'a"
clasohm@1474
    36
 SND    :: "'a*'b => 'b"
clasohm@0
    37
 INL    :: "'a => 'a+'b"
clasohm@0
    38
 INR    :: "'b => 'a+'b"
clasohm@0
    39
 WHEN   :: "['a=>'c, 'b=>'c, 'a+'b] => 'c"
clasohm@1474
    40
 adm    :: "('a => o) => o"
clasohm@1474
    41
 VOID   :: "void"               ("'(')")
clasohm@1474
    42
 PAIR   :: "['a,'b] => 'a*'b"   ("(1<_,/_>)" [0,0] 100)
clasohm@1474
    43
 COND   :: "[tr,'a,'a] => 'a"   ("(_ =>/ (_ |/ _))" [60,60,60] 60)
wenzelm@22810
    44
 less   :: "['a,'a] => o"       (infixl "<<" 50)
wenzelm@17248
    45
wenzelm@47025
    46
axiomatization where
clasohm@0
    47
  (** DOMAIN THEORY **)
clasohm@0
    48
wenzelm@47025
    49
  eq_def:        "x=y == x << y & y << x" and
clasohm@0
    50
wenzelm@47025
    51
  less_trans:    "[| x << y; y << z |] ==> x << z" and
clasohm@0
    52
wenzelm@47025
    53
  less_ext:      "(ALL x. f(x) << g(x)) ==> f << g" and
clasohm@0
    54
wenzelm@47025
    55
  mono:          "[| f << g; x << y |] ==> f(x) << g(y)" and
wenzelm@47025
    56
wenzelm@47025
    57
  minimal:       "UU << x" and
clasohm@0
    58
wenzelm@47025
    59
  FIX_eq:        "\<And>f. f(FIX(f)) = FIX(f)"
clasohm@0
    60
wenzelm@47025
    61
axiomatization where
clasohm@0
    62
  (** TR **)
clasohm@0
    63
wenzelm@47025
    64
  tr_cases:      "p=UU | p=TT | p=FF" and
clasohm@0
    65
wenzelm@47025
    66
  not_TT_less_FF: "~ TT << FF" and
wenzelm@47025
    67
  not_FF_less_TT: "~ FF << TT" and
wenzelm@47025
    68
  not_TT_less_UU: "~ TT << UU" and
wenzelm@47025
    69
  not_FF_less_UU: "~ FF << UU" and
clasohm@0
    70
wenzelm@47025
    71
  COND_UU:       "UU => x | y  =  UU" and
wenzelm@47025
    72
  COND_TT:       "TT => x | y  =  x" and
wenzelm@17248
    73
  COND_FF:       "FF => x | y  =  y"
clasohm@0
    74
wenzelm@47025
    75
axiomatization where
clasohm@0
    76
  (** PAIRS **)
clasohm@0
    77
wenzelm@47025
    78
  surj_pairing:  "<FST(z),SND(z)> = z" and
clasohm@0
    79
wenzelm@47025
    80
  FST:   "FST(<x,y>) = x" and
wenzelm@17248
    81
  SND:   "SND(<x,y>) = y"
clasohm@0
    82
wenzelm@47025
    83
axiomatization where
clasohm@0
    84
  (*** STRICT SUM ***)
clasohm@0
    85
wenzelm@47025
    86
  INL_DEF: "~x=UU ==> ~INL(x)=UU" and
wenzelm@47025
    87
  INR_DEF: "~x=UU ==> ~INR(x)=UU" and
clasohm@0
    88
wenzelm@47025
    89
  INL_STRICT: "INL(UU) = UU" and
wenzelm@47025
    90
  INR_STRICT: "INR(UU) = UU" and
clasohm@0
    91
wenzelm@47025
    92
  WHEN_UU:  "WHEN(f,g,UU) = UU" and
wenzelm@47025
    93
  WHEN_INL: "~x=UU ==> WHEN(f,g,INL(x)) = f(x)" and
wenzelm@47025
    94
  WHEN_INR: "~x=UU ==> WHEN(f,g,INR(x)) = g(x)" and
clasohm@0
    95
wenzelm@17248
    96
  SUM_EXHAUSTION:
clasohm@0
    97
    "z = UU | (EX x. ~x=UU & z = INL(x)) | (EX y. ~y=UU & z = INR(y))"
clasohm@0
    98
wenzelm@47025
    99
axiomatization where
clasohm@0
   100
  (** VOID **)
clasohm@0
   101
wenzelm@17248
   102
  void_cases:    "(x::void) = UU"
clasohm@0
   103
clasohm@0
   104
  (** INDUCTION **)
clasohm@0
   105
wenzelm@47025
   106
axiomatization where
wenzelm@17248
   107
  induct:        "[| adm(P); P(UU); ALL x. P(x) --> P(f(x)) |] ==> P(FIX(f))"
clasohm@0
   108
wenzelm@47025
   109
axiomatization where
clasohm@0
   110
  (** Admissibility / Chain Completeness **)
clasohm@0
   111
  (* All rules can be found on pages 199--200 of Larry's LCF book.
clasohm@0
   112
     Note that "easiness" of types is not taken into account
clasohm@0
   113
     because it cannot be expressed schematically; flatness could be. *)
clasohm@0
   114
wenzelm@47025
   115
  adm_less:      "\<And>t u. adm(%x. t(x) << u(x))" and
wenzelm@47025
   116
  adm_not_less:  "\<And>t u. adm(%x.~ t(x) << u)" and
wenzelm@47025
   117
  adm_not_free:  "\<And>A. adm(%x. A)" and
wenzelm@47025
   118
  adm_subst:     "\<And>P t. adm(P) ==> adm(%x. P(t(x)))" and
wenzelm@47025
   119
  adm_conj:      "\<And>P Q. [| adm(P); adm(Q) |] ==> adm(%x. P(x)&Q(x))" and
wenzelm@47025
   120
  adm_disj:      "\<And>P Q. [| adm(P); adm(Q) |] ==> adm(%x. P(x)|Q(x))" and
wenzelm@47025
   121
  adm_imp:       "\<And>P Q. [| adm(%x.~P(x)); adm(Q) |] ==> adm(%x. P(x)-->Q(x))" and
wenzelm@47025
   122
  adm_all:       "\<And>P. (!!y. adm(P(y))) ==> adm(%x. ALL y. P(y,x))"
wenzelm@17248
   123
wenzelm@19757
   124
wenzelm@19757
   125
lemma eq_imp_less1: "x = y ==> x << y"
wenzelm@19757
   126
  by (simp add: eq_def)
wenzelm@19757
   127
wenzelm@19757
   128
lemma eq_imp_less2: "x = y ==> y << x"
wenzelm@19757
   129
  by (simp add: eq_def)
wenzelm@19757
   130
wenzelm@19757
   131
lemma less_refl [simp]: "x << x"
wenzelm@19757
   132
  apply (rule eq_imp_less1)
wenzelm@19757
   133
  apply (rule refl)
wenzelm@19757
   134
  done
wenzelm@19757
   135
wenzelm@19757
   136
lemma less_anti_sym: "[| x << y; y << x |] ==> x=y"
wenzelm@19757
   137
  by (simp add: eq_def)
wenzelm@19757
   138
wenzelm@19757
   139
lemma ext: "(!!x::'a::cpo. f(x)=(g(x)::'b::cpo)) ==> (%x. f(x))=(%x. g(x))"
wenzelm@19757
   140
  apply (rule less_anti_sym)
wenzelm@19757
   141
  apply (rule less_ext)
wenzelm@19757
   142
  apply simp
wenzelm@19757
   143
  apply simp
wenzelm@19757
   144
  done
wenzelm@19757
   145
wenzelm@19757
   146
lemma cong: "[| f=g; x=y |] ==> f(x)=g(y)"
wenzelm@19757
   147
  by simp
wenzelm@19757
   148
wenzelm@19757
   149
lemma less_ap_term: "x << y ==> f(x) << f(y)"
wenzelm@19757
   150
  by (rule less_refl [THEN mono])
wenzelm@19757
   151
wenzelm@19757
   152
lemma less_ap_thm: "f << g ==> f(x) << g(x)"
wenzelm@19757
   153
  by (rule less_refl [THEN [2] mono])
wenzelm@19757
   154
wenzelm@19757
   155
lemma ap_term: "(x::'a::cpo) = y ==> (f(x)::'b::cpo) = f(y)"
wenzelm@19757
   156
  apply (rule cong [OF refl])
wenzelm@19757
   157
  apply simp
wenzelm@19757
   158
  done
wenzelm@19757
   159
wenzelm@19757
   160
lemma ap_thm: "f = g ==> f(x) = g(x)"
wenzelm@19757
   161
  apply (erule cong)
wenzelm@19757
   162
  apply (rule refl)
wenzelm@19757
   163
  done
wenzelm@19757
   164
wenzelm@19757
   165
wenzelm@19757
   166
lemma UU_abs: "(%x::'a::cpo. UU) = UU"
wenzelm@19757
   167
  apply (rule less_anti_sym)
wenzelm@19757
   168
  prefer 2
wenzelm@19757
   169
  apply (rule minimal)
wenzelm@19757
   170
  apply (rule less_ext)
wenzelm@19757
   171
  apply (rule allI)
wenzelm@19757
   172
  apply (rule minimal)
wenzelm@19757
   173
  done
wenzelm@19757
   174
wenzelm@19757
   175
lemma UU_app: "UU(x) = UU"
wenzelm@19757
   176
  by (rule UU_abs [symmetric, THEN ap_thm])
wenzelm@19757
   177
wenzelm@19757
   178
lemma less_UU: "x << UU ==> x=UU"
wenzelm@19757
   179
  apply (rule less_anti_sym)
wenzelm@19757
   180
  apply assumption
wenzelm@19757
   181
  apply (rule minimal)
wenzelm@19757
   182
  done
wenzelm@17248
   183
wenzelm@19757
   184
lemma tr_induct: "[| P(UU); P(TT); P(FF) |] ==> ALL b. P(b)"
wenzelm@19757
   185
  apply (rule allI)
wenzelm@19757
   186
  apply (rule mp)
wenzelm@19757
   187
  apply (rule_tac [2] p = b in tr_cases)
wenzelm@19757
   188
  apply blast
wenzelm@19757
   189
  done
wenzelm@19757
   190
wenzelm@19757
   191
lemma Contrapos: "~ B ==> (A ==> B) ==> ~A"
wenzelm@19757
   192
  by blast
wenzelm@19757
   193
wenzelm@19757
   194
lemma not_less_imp_not_eq1: "~ x << y \<Longrightarrow> x \<noteq> y"
wenzelm@19757
   195
  apply (erule Contrapos)
wenzelm@19757
   196
  apply simp
wenzelm@19757
   197
  done
wenzelm@19757
   198
wenzelm@19757
   199
lemma not_less_imp_not_eq2: "~ y << x \<Longrightarrow> x \<noteq> y"
wenzelm@19757
   200
  apply (erule Contrapos)
wenzelm@19757
   201
  apply simp
wenzelm@19757
   202
  done
wenzelm@19757
   203
wenzelm@19757
   204
lemma not_UU_eq_TT: "UU \<noteq> TT"
wenzelm@19757
   205
  by (rule not_less_imp_not_eq2) (rule not_TT_less_UU)
wenzelm@19757
   206
lemma not_UU_eq_FF: "UU \<noteq> FF"
wenzelm@19757
   207
  by (rule not_less_imp_not_eq2) (rule not_FF_less_UU)
wenzelm@19757
   208
lemma not_TT_eq_UU: "TT \<noteq> UU"
wenzelm@19757
   209
  by (rule not_less_imp_not_eq1) (rule not_TT_less_UU)
wenzelm@19757
   210
lemma not_TT_eq_FF: "TT \<noteq> FF"
wenzelm@19757
   211
  by (rule not_less_imp_not_eq1) (rule not_TT_less_FF)
wenzelm@19757
   212
lemma not_FF_eq_UU: "FF \<noteq> UU"
wenzelm@19757
   213
  by (rule not_less_imp_not_eq1) (rule not_FF_less_UU)
wenzelm@19757
   214
lemma not_FF_eq_TT: "FF \<noteq> TT"
wenzelm@19757
   215
  by (rule not_less_imp_not_eq1) (rule not_FF_less_TT)
wenzelm@19757
   216
wenzelm@19757
   217
wenzelm@19757
   218
lemma COND_cases_iff [rule_format]:
wenzelm@19757
   219
    "ALL b. P(b=>x|y) <-> (b=UU-->P(UU)) & (b=TT-->P(x)) & (b=FF-->P(y))"
wenzelm@19757
   220
  apply (insert not_UU_eq_TT not_UU_eq_FF not_TT_eq_UU
wenzelm@19757
   221
    not_TT_eq_FF not_FF_eq_UU not_FF_eq_TT)
wenzelm@19757
   222
  apply (rule tr_induct)
wenzelm@19757
   223
  apply (simplesubst COND_UU)
wenzelm@19757
   224
  apply blast
wenzelm@19757
   225
  apply (simplesubst COND_TT)
wenzelm@19757
   226
  apply blast
wenzelm@19757
   227
  apply (simplesubst COND_FF)
wenzelm@19757
   228
  apply blast
wenzelm@19757
   229
  done
wenzelm@19757
   230
wenzelm@19757
   231
lemma COND_cases: 
wenzelm@19757
   232
  "[| x = UU --> P(UU); x = TT --> P(xa); x = FF --> P(y) |] ==> P(x => xa | y)"
wenzelm@19757
   233
  apply (rule COND_cases_iff [THEN iffD2])
wenzelm@19757
   234
  apply blast
wenzelm@19757
   235
  done
wenzelm@19757
   236
wenzelm@19757
   237
lemmas [simp] =
wenzelm@19757
   238
  minimal
wenzelm@19757
   239
  UU_app
wenzelm@19757
   240
  UU_app [THEN ap_thm]
wenzelm@19757
   241
  UU_app [THEN ap_thm, THEN ap_thm]
wenzelm@19757
   242
  not_TT_less_FF not_FF_less_TT not_TT_less_UU not_FF_less_UU not_UU_eq_TT
wenzelm@19757
   243
  not_UU_eq_FF not_TT_eq_UU not_TT_eq_FF not_FF_eq_UU not_FF_eq_TT
wenzelm@19757
   244
  COND_UU COND_TT COND_FF
wenzelm@19757
   245
  surj_pairing FST SND
wenzelm@17248
   246
wenzelm@17248
   247
wenzelm@17248
   248
subsection {* Ordered pairs and products *}
wenzelm@17248
   249
wenzelm@19757
   250
lemma expand_all_PROD: "(ALL p. P(p)) <-> (ALL x y. P(<x,y>))"
wenzelm@19757
   251
  apply (rule iffI)
wenzelm@19757
   252
  apply blast
wenzelm@19757
   253
  apply (rule allI)
wenzelm@19757
   254
  apply (rule surj_pairing [THEN subst])
wenzelm@19757
   255
  apply blast
wenzelm@19757
   256
  done
wenzelm@19757
   257
wenzelm@19757
   258
lemma PROD_less: "(p::'a*'b) << q <-> FST(p) << FST(q) & SND(p) << SND(q)"
wenzelm@19757
   259
  apply (rule iffI)
wenzelm@19757
   260
  apply (rule conjI)
wenzelm@19757
   261
  apply (erule less_ap_term)
wenzelm@19757
   262
  apply (erule less_ap_term)
wenzelm@19757
   263
  apply (erule conjE)
wenzelm@19757
   264
  apply (rule surj_pairing [of p, THEN subst])
wenzelm@19757
   265
  apply (rule surj_pairing [of q, THEN subst])
wenzelm@19757
   266
  apply (rule mono, erule less_ap_term, assumption)
wenzelm@19757
   267
  done
wenzelm@19757
   268
wenzelm@19757
   269
lemma PROD_eq: "p=q <-> FST(p)=FST(q) & SND(p)=SND(q)"
wenzelm@19757
   270
  apply (rule iffI)
wenzelm@19757
   271
  apply simp
wenzelm@19757
   272
  apply (unfold eq_def)
wenzelm@19757
   273
  apply (simp add: PROD_less)
wenzelm@19757
   274
  done
wenzelm@19757
   275
wenzelm@19757
   276
lemma PAIR_less [simp]: "<a,b> << <c,d> <-> a<<c & b<<d"
wenzelm@19757
   277
  by (simp add: PROD_less)
wenzelm@19757
   278
wenzelm@19757
   279
lemma PAIR_eq [simp]: "<a,b> = <c,d> <-> a=c & b=d"
wenzelm@19757
   280
  by (simp add: PROD_eq)
wenzelm@19757
   281
wenzelm@19757
   282
lemma UU_is_UU_UU [simp]: "<UU,UU> = UU"
wenzelm@19757
   283
  by (rule less_UU) (simp add: PROD_less)
wenzelm@19757
   284
wenzelm@19757
   285
lemma FST_STRICT [simp]: "FST(UU) = UU"
wenzelm@19757
   286
  apply (rule subst [OF UU_is_UU_UU])
wenzelm@19757
   287
  apply (simp del: UU_is_UU_UU)
wenzelm@19757
   288
  done
wenzelm@19757
   289
wenzelm@19757
   290
lemma SND_STRICT [simp]: "SND(UU) = UU"
wenzelm@19757
   291
  apply (rule subst [OF UU_is_UU_UU])
wenzelm@19757
   292
  apply (simp del: UU_is_UU_UU)
wenzelm@19757
   293
  done
wenzelm@17248
   294
wenzelm@17248
   295
wenzelm@17248
   296
subsection {* Fixedpoint theory *}
wenzelm@17248
   297
wenzelm@19757
   298
lemma adm_eq: "adm(%x. t(x)=(u(x)::'a::cpo))"
wenzelm@19757
   299
  apply (unfold eq_def)
wenzelm@19757
   300
  apply (rule adm_conj adm_less)+
wenzelm@19757
   301
  done
wenzelm@19757
   302
wenzelm@19757
   303
lemma adm_not_not: "adm(P) ==> adm(%x.~~P(x))"
wenzelm@19757
   304
  by simp
wenzelm@19757
   305
wenzelm@19757
   306
lemma not_eq_TT: "ALL p. ~p=TT <-> (p=FF | p=UU)"
wenzelm@19757
   307
  and not_eq_FF: "ALL p. ~p=FF <-> (p=TT | p=UU)"
wenzelm@19757
   308
  and not_eq_UU: "ALL p. ~p=UU <-> (p=TT | p=FF)"
wenzelm@19757
   309
  by (rule tr_induct, simp_all)+
wenzelm@19757
   310
wenzelm@19757
   311
lemma adm_not_eq_tr: "ALL p::tr. adm(%x. ~t(x)=p)"
wenzelm@19757
   312
  apply (rule tr_induct)
wenzelm@19757
   313
  apply (simp_all add: not_eq_TT not_eq_FF not_eq_UU)
wenzelm@19757
   314
  apply (rule adm_disj adm_eq)+
wenzelm@19757
   315
  done
wenzelm@19757
   316
wenzelm@19757
   317
lemmas adm_lemmas =
wenzelm@19757
   318
  adm_not_free adm_eq adm_less adm_not_less
wenzelm@19757
   319
  adm_not_eq_tr adm_conj adm_disj adm_imp adm_all
wenzelm@19757
   320
wenzelm@19757
   321
wenzelm@19757
   322
ML {*
wenzelm@27208
   323
  fun induct_tac ctxt v i =
wenzelm@27239
   324
    res_inst_tac ctxt [(("f", 0), v)] @{thm induct} i THEN
wenzelm@22810
   325
    REPEAT (resolve_tac @{thms adm_lemmas} i)
wenzelm@19757
   326
*}
wenzelm@19757
   327
wenzelm@19757
   328
lemma least_FIX: "f(p) = p ==> FIX(f) << p"
wenzelm@27208
   329
  apply (tactic {* induct_tac @{context} "f" 1 *})
wenzelm@19757
   330
  apply (rule minimal)
wenzelm@19757
   331
  apply (intro strip)
wenzelm@19757
   332
  apply (erule subst)
wenzelm@19757
   333
  apply (erule less_ap_term)
wenzelm@19757
   334
  done
wenzelm@19757
   335
wenzelm@19757
   336
lemma lfp_is_FIX:
wenzelm@19757
   337
  assumes 1: "f(p) = p"
wenzelm@19757
   338
    and 2: "ALL q. f(q)=q --> p << q"
wenzelm@19757
   339
  shows "p = FIX(f)"
wenzelm@19757
   340
  apply (rule less_anti_sym)
wenzelm@19757
   341
  apply (rule 2 [THEN spec, THEN mp])
wenzelm@19757
   342
  apply (rule FIX_eq)
wenzelm@19757
   343
  apply (rule least_FIX)
wenzelm@19757
   344
  apply (rule 1)
wenzelm@19757
   345
  done
wenzelm@19757
   346
wenzelm@19757
   347
wenzelm@19757
   348
lemma FIX_pair: "<FIX(f),FIX(g)> = FIX(%p.<f(FST(p)),g(SND(p))>)"
wenzelm@19757
   349
  apply (rule lfp_is_FIX)
wenzelm@19757
   350
  apply (simp add: FIX_eq [of f] FIX_eq [of g])
wenzelm@19757
   351
  apply (intro strip)
wenzelm@19757
   352
  apply (simp add: PROD_less)
wenzelm@19757
   353
  apply (rule conjI)
wenzelm@19757
   354
  apply (rule least_FIX)
wenzelm@19757
   355
  apply (erule subst, rule FST [symmetric])
wenzelm@19757
   356
  apply (rule least_FIX)
wenzelm@19757
   357
  apply (erule subst, rule SND [symmetric])
wenzelm@19757
   358
  done
wenzelm@19757
   359
wenzelm@19757
   360
lemma FIX1: "FIX(f) = FST(FIX(%p. <f(FST(p)),g(SND(p))>))"
wenzelm@19757
   361
  by (rule FIX_pair [unfolded PROD_eq FST SND, THEN conjunct1])
wenzelm@19757
   362
wenzelm@19757
   363
lemma FIX2: "FIX(g) = SND(FIX(%p. <f(FST(p)),g(SND(p))>))"
wenzelm@19757
   364
  by (rule FIX_pair [unfolded PROD_eq FST SND, THEN conjunct2])
wenzelm@19757
   365
wenzelm@19757
   366
lemma induct2:
wenzelm@19757
   367
  assumes 1: "adm(%p. P(FST(p),SND(p)))"
wenzelm@19757
   368
    and 2: "P(UU::'a,UU::'b)"
wenzelm@19757
   369
    and 3: "ALL x y. P(x,y) --> P(f(x),g(y))"
wenzelm@19757
   370
  shows "P(FIX(f),FIX(g))"
wenzelm@19757
   371
  apply (rule FIX1 [THEN ssubst, of _ f g])
wenzelm@19757
   372
  apply (rule FIX2 [THEN ssubst, of _ f g])
wenzelm@19758
   373
  apply (rule induct [where ?f = "%x. <f(FST(x)),g(SND(x))>"])
wenzelm@19758
   374
  apply (rule 1)
wenzelm@19757
   375
  apply simp
wenzelm@19757
   376
  apply (rule 2)
wenzelm@19757
   377
  apply (simp add: expand_all_PROD)
wenzelm@19757
   378
  apply (rule 3)
wenzelm@19757
   379
  done
wenzelm@19757
   380
wenzelm@19757
   381
ML {*
wenzelm@27208
   382
fun induct2_tac ctxt (f, g) i =
wenzelm@27239
   383
  res_inst_tac ctxt [(("f", 0), f), (("g", 0), g)] @{thm induct2} i THEN
wenzelm@22810
   384
  REPEAT(resolve_tac @{thms adm_lemmas} i)
wenzelm@19757
   385
*}
wenzelm@19757
   386
wenzelm@19757
   387
end