src/CCL/Type.thy
author wenzelm
Mon Sep 06 19:13:10 2010 +0200 (2010-09-06)
changeset 39159 0dec18004e75
parent 35409 5c5bb83f2bae
child 41526 54b4686704af
permissions -rw-r--r--
more antiquotations;
     1 (*  Title:      CCL/Type.thy
     2     Author:     Martin Coen
     3     Copyright   1993  University of Cambridge
     4 *)
     5 
     6 header {* Types in CCL are defined as sets of terms *}
     7 
     8 theory Type
     9 imports Term
    10 begin
    11 
    12 consts
    13 
    14   Subtype       :: "['a set, 'a => o] => 'a set"
    15   Bool          :: "i set"
    16   Unit          :: "i set"
    17   Plus           :: "[i set, i set] => i set"        (infixr "+" 55)
    18   Pi            :: "[i set, i => i set] => i set"
    19   Sigma         :: "[i set, i => i set] => i set"
    20   Nat           :: "i set"
    21   List          :: "i set => i set"
    22   Lists         :: "i set => i set"
    23   ILists        :: "i set => i set"
    24   TAll          :: "(i set => i set) => i set"       (binder "TALL " 55)
    25   TEx           :: "(i set => i set) => i set"       (binder "TEX " 55)
    26   Lift          :: "i set => i set"                  ("(3[_])")
    27 
    28   SPLIT         :: "[i, [i, i] => i set] => i set"
    29 
    30 syntax
    31   "_Pi"         :: "[idt, i set, i set] => i set"    ("(3PROD _:_./ _)"
    32                                 [0,0,60] 60)
    33 
    34   "_Sigma"      :: "[idt, i set, i set] => i set"    ("(3SUM _:_./ _)"
    35                                 [0,0,60] 60)
    36 
    37   "_arrow"      :: "[i set, i set] => i set"         ("(_ ->/ _)"  [54, 53] 53)
    38   "_star"       :: "[i set, i set] => i set"         ("(_ */ _)" [56, 55] 55)
    39   "_Subtype"    :: "[idt, 'a set, o] => 'a set"      ("(1{_: _ ./ _})")
    40 
    41 translations
    42   "PROD x:A. B" => "CONST Pi(A, %x. B)"
    43   "A -> B"      => "CONST Pi(A, %_. B)"
    44   "SUM x:A. B"  => "CONST Sigma(A, %x. B)"
    45   "A * B"       => "CONST Sigma(A, %_. B)"
    46   "{x: A. B}"   == "CONST Subtype(A, %x. B)"
    47 
    48 print_translation {*
    49  [(@{const_syntax Pi}, dependent_tr' (@{syntax_const "_Pi"}, @{syntax_const "_arrow"})),
    50   (@{const_syntax Sigma}, dependent_tr' (@{syntax_const "_Sigma"}, @{syntax_const "_star"}))]
    51 *}
    52 
    53 axioms
    54   Subtype_def: "{x:A. P(x)} == {x. x:A & P(x)}"
    55   Unit_def:          "Unit == {x. x=one}"
    56   Bool_def:          "Bool == {x. x=true | x=false}"
    57   Plus_def:           "A+B == {x. (EX a:A. x=inl(a)) | (EX b:B. x=inr(b))}"
    58   Pi_def:         "Pi(A,B) == {x. EX b. x=lam x. b(x) & (ALL x:A. b(x):B(x))}"
    59   Sigma_def:   "Sigma(A,B) == {x. EX a:A. EX b:B(a).x=<a,b>}"
    60   Nat_def:            "Nat == lfp(% X. Unit + X)"
    61   List_def:       "List(A) == lfp(% X. Unit + A*X)"
    62 
    63   Lists_def:     "Lists(A) == gfp(% X. Unit + A*X)"
    64   ILists_def:   "ILists(A) == gfp(% X.{} + A*X)"
    65 
    66   Tall_def:   "TALL X. B(X) == Inter({X. EX Y. X=B(Y)})"
    67   Tex_def:     "TEX X. B(X) == Union({X. EX Y. X=B(Y)})"
    68   Lift_def:           "[A] == A Un {bot}"
    69 
    70   SPLIT_def:   "SPLIT(p,B) == Union({A. EX x y. p=<x,y> & A=B(x,y)})"
    71 
    72 
    73 lemmas simp_type_defs =
    74     Subtype_def Unit_def Bool_def Plus_def Sigma_def Pi_def Lift_def Tall_def Tex_def
    75   and ind_type_defs = Nat_def List_def
    76   and simp_data_defs = one_def inl_def inr_def
    77   and ind_data_defs = zero_def succ_def nil_def cons_def
    78 
    79 lemma subsetXH: "A <= B <-> (ALL x. x:A --> x:B)"
    80   by blast
    81 
    82 
    83 subsection {* Exhaustion Rules *}
    84 
    85 lemma EmptyXH: "!!a. a : {} <-> False"
    86   and SubtypeXH: "!!a A P. a : {x:A. P(x)} <-> (a:A & P(a))"
    87   and UnitXH: "!!a. a : Unit          <-> a=one"
    88   and BoolXH: "!!a. a : Bool          <-> a=true | a=false"
    89   and PlusXH: "!!a A B. a : A+B           <-> (EX x:A. a=inl(x)) | (EX x:B. a=inr(x))"
    90   and PiXH: "!!a A B. a : PROD x:A. B(x) <-> (EX b. a=lam x. b(x) & (ALL x:A. b(x):B(x)))"
    91   and SgXH: "!!a A B. a : SUM x:A. B(x)  <-> (EX x:A. EX y:B(x).a=<x,y>)"
    92   unfolding simp_type_defs by blast+
    93 
    94 lemmas XHs = EmptyXH SubtypeXH UnitXH BoolXH PlusXH PiXH SgXH
    95 
    96 lemma LiftXH: "a : [A] <-> (a=bot | a:A)"
    97   and TallXH: "a : TALL X. B(X) <-> (ALL X. a:B(X))"
    98   and TexXH: "a : TEX X. B(X) <-> (EX X. a:B(X))"
    99   unfolding simp_type_defs by blast+
   100 
   101 ML {*
   102 bind_thms ("case_rls", XH_to_Es @{thms XHs});
   103 *}
   104 
   105 
   106 subsection {* Canonical Type Rules *}
   107 
   108 lemma oneT: "one : Unit"
   109   and trueT: "true : Bool"
   110   and falseT: "false : Bool"
   111   and lamT: "!!b B. [| !!x. x:A ==> b(x):B(x) |] ==> lam x. b(x) : Pi(A,B)"
   112   and pairT: "!!b B. [| a:A; b:B(a) |] ==> <a,b>:Sigma(A,B)"
   113   and inlT: "a:A ==> inl(a) : A+B"
   114   and inrT: "b:B ==> inr(b) : A+B"
   115   by (blast intro: XHs [THEN iffD2])+
   116 
   117 lemmas canTs = oneT trueT falseT pairT lamT inlT inrT
   118 
   119 
   120 subsection {* Non-Canonical Type Rules *}
   121 
   122 lemma lem: "[| a:B(u);  u=v |] ==> a : B(v)"
   123   by blast
   124 
   125 
   126 ML {*
   127 fun mk_ncanT_tac top_crls crls =
   128   SUBPROOF (fn {context = ctxt, prems = major :: prems, ...} =>
   129     resolve_tac ([major] RL top_crls) 1 THEN
   130     REPEAT_SOME (eresolve_tac (crls @ [@{thm exE}, @{thm bexE}, @{thm conjE}, @{thm disjE}])) THEN
   131     ALLGOALS (asm_simp_tac (simpset_of ctxt)) THEN
   132     ALLGOALS (ares_tac (prems RL [@{thm lem}]) ORELSE' etac @{thm bspec}) THEN
   133     safe_tac (claset_of ctxt addSIs prems))
   134 *}
   135 
   136 method_setup ncanT = {*
   137   Scan.succeed (SIMPLE_METHOD' o mk_ncanT_tac @{thms case_rls} @{thms case_rls})
   138 *} ""
   139 
   140 lemma ifT:
   141   "[| b:Bool; b=true ==> t:A(true); b=false ==> u:A(false) |] ==>
   142     if b then t else u : A(b)"
   143   by ncanT
   144 
   145 lemma applyT: "[| f : Pi(A,B);  a:A |] ==> f ` a : B(a)"
   146   by ncanT
   147 
   148 lemma splitT:
   149   "[| p:Sigma(A,B); !!x y. [| x:A;  y:B(x); p=<x,y> |] ==> c(x,y):C(<x,y>) |]
   150     ==> split(p,c):C(p)"
   151   by ncanT
   152 
   153 lemma whenT:
   154   "[| p:A+B; !!x.[| x:A;  p=inl(x) |] ==> a(x):C(inl(x)); !!y.[| y:B;  p=inr(y) |]
   155     ==> b(y):C(inr(y)) |] ==> when(p,a,b) : C(p)"
   156   by ncanT
   157 
   158 lemmas ncanTs = ifT applyT splitT whenT
   159 
   160 
   161 subsection {* Subtypes *}
   162 
   163 lemma SubtypeD1: "a : Subtype(A, P) ==> a : A"
   164   and SubtypeD2: "a : Subtype(A, P) ==> P(a)"
   165   by (simp_all add: SubtypeXH)
   166 
   167 lemma SubtypeI: "[| a:A;  P(a) |] ==> a : {x:A. P(x)}"
   168   by (simp add: SubtypeXH)
   169 
   170 lemma SubtypeE: "[| a : {x:A. P(x)};  [| a:A;  P(a) |] ==> Q |] ==> Q"
   171   by (simp add: SubtypeXH)
   172 
   173 
   174 subsection {* Monotonicity *}
   175 
   176 lemma idM: "mono (%X. X)"
   177   apply (rule monoI)
   178   apply assumption
   179   done
   180 
   181 lemma constM: "mono(%X. A)"
   182   apply (rule monoI)
   183   apply (rule subset_refl)
   184   done
   185 
   186 lemma "mono(%X. A(X)) ==> mono(%X.[A(X)])"
   187   apply (rule subsetI [THEN monoI])
   188   apply (drule LiftXH [THEN iffD1])
   189   apply (erule disjE)
   190    apply (erule disjI1 [THEN LiftXH [THEN iffD2]])
   191   apply (rule disjI2 [THEN LiftXH [THEN iffD2]])
   192   apply (drule (1) monoD)
   193   apply blast
   194   done
   195 
   196 lemma SgM:
   197   "[| mono(%X. A(X)); !!x X. x:A(X) ==> mono(%X. B(X,x)) |] ==>
   198     mono(%X. Sigma(A(X),B(X)))"
   199   by (blast intro!: subsetI [THEN monoI] canTs elim!: case_rls
   200     dest!: monoD [THEN subsetD])
   201 
   202 lemma PiM:
   203   "[| !!x. x:A ==> mono(%X. B(X,x)) |] ==> mono(%X. Pi(A,B(X)))"
   204   by (blast intro!: subsetI [THEN monoI] canTs elim!: case_rls
   205     dest!: monoD [THEN subsetD])
   206 
   207 lemma PlusM:
   208     "[| mono(%X. A(X));  mono(%X. B(X)) |] ==> mono(%X. A(X)+B(X))"
   209   by (blast intro!: subsetI [THEN monoI] canTs elim!: case_rls
   210     dest!: monoD [THEN subsetD])
   211 
   212 
   213 subsection {* Recursive types *}
   214 
   215 subsubsection {* Conversion Rules for Fixed Points via monotonicity and Tarski *}
   216 
   217 lemma NatM: "mono(%X. Unit+X)";
   218   apply (rule PlusM constM idM)+
   219   done
   220 
   221 lemma def_NatB: "Nat = Unit + Nat"
   222   apply (rule def_lfp_Tarski [OF Nat_def])
   223   apply (rule NatM)
   224   done
   225 
   226 lemma ListM: "mono(%X.(Unit+Sigma(A,%y. X)))"
   227   apply (rule PlusM SgM constM idM)+
   228   done
   229 
   230 lemma def_ListB: "List(A) = Unit + A * List(A)"
   231   apply (rule def_lfp_Tarski [OF List_def])
   232   apply (rule ListM)
   233   done
   234 
   235 lemma def_ListsB: "Lists(A) = Unit + A * Lists(A)"
   236   apply (rule def_gfp_Tarski [OF Lists_def])
   237   apply (rule ListM)
   238   done
   239 
   240 lemma IListsM: "mono(%X.({} + Sigma(A,%y. X)))"
   241   apply (rule PlusM SgM constM idM)+
   242   done
   243 
   244 lemma def_IListsB: "ILists(A) = {} + A * ILists(A)"
   245   apply (rule def_gfp_Tarski [OF ILists_def])
   246   apply (rule IListsM)
   247   done
   248 
   249 lemmas ind_type_eqs = def_NatB def_ListB def_ListsB def_IListsB
   250 
   251 
   252 subsection {* Exhaustion Rules *}
   253 
   254 lemma NatXH: "a : Nat <-> (a=zero | (EX x:Nat. a=succ(x)))"
   255   and ListXH: "a : List(A) <-> (a=[] | (EX x:A. EX xs:List(A).a=x$xs))"
   256   and ListsXH: "a : Lists(A) <-> (a=[] | (EX x:A. EX xs:Lists(A).a=x$xs))"
   257   and IListsXH: "a : ILists(A) <-> (EX x:A. EX xs:ILists(A).a=x$xs)"
   258   unfolding ind_data_defs
   259   by (rule ind_type_eqs [THEN XHlemma1], blast intro!: canTs elim!: case_rls)+
   260 
   261 lemmas iXHs = NatXH ListXH
   262 
   263 ML {* bind_thms ("icase_rls", XH_to_Es @{thms iXHs}) *}
   264 
   265 
   266 subsection {* Type Rules *}
   267 
   268 lemma zeroT: "zero : Nat"
   269   and succT: "n:Nat ==> succ(n) : Nat"
   270   and nilT: "[] : List(A)"
   271   and consT: "[| h:A;  t:List(A) |] ==> h$t : List(A)"
   272   by (blast intro: iXHs [THEN iffD2])+
   273 
   274 lemmas icanTs = zeroT succT nilT consT
   275 
   276 
   277 method_setup incanT = {*
   278   Scan.succeed (SIMPLE_METHOD' o mk_ncanT_tac @{thms icase_rls} @{thms case_rls})
   279 *} ""
   280 
   281 lemma ncaseT:
   282   "[| n:Nat; n=zero ==> b:C(zero); !!x.[| x:Nat;  n=succ(x) |] ==> c(x):C(succ(x)) |]
   283     ==> ncase(n,b,c) : C(n)"
   284   by incanT
   285 
   286 lemma lcaseT:
   287   "[| l:List(A); l=[] ==> b:C([]); !!h t.[| h:A;  t:List(A); l=h$t |] ==>
   288     c(h,t):C(h$t) |] ==> lcase(l,b,c) : C(l)"
   289   by incanT
   290 
   291 lemmas incanTs = ncaseT lcaseT
   292 
   293 
   294 subsection {* Induction Rules *}
   295 
   296 lemmas ind_Ms = NatM ListM
   297 
   298 lemma Nat_ind: "[| n:Nat; P(zero); !!x.[| x:Nat; P(x) |] ==> P(succ(x)) |] ==> P(n)"
   299   apply (unfold ind_data_defs)
   300   apply (erule def_induct [OF Nat_def _ NatM])
   301   apply (blast intro: canTs elim!: case_rls)
   302   done
   303 
   304 lemma List_ind:
   305   "[| l:List(A); P([]); !!x xs.[| x:A;  xs:List(A); P(xs) |] ==> P(x$xs) |] ==> P(l)"
   306   apply (unfold ind_data_defs)
   307   apply (erule def_induct [OF List_def _ ListM])
   308   apply (blast intro: canTs elim!: case_rls)
   309   done
   310 
   311 lemmas inds = Nat_ind List_ind
   312 
   313 
   314 subsection {* Primitive Recursive Rules *}
   315 
   316 lemma nrecT:
   317   "[| n:Nat; b:C(zero);
   318       !!x g.[| x:Nat; g:C(x) |] ==> c(x,g):C(succ(x)) |] ==>
   319       nrec(n,b,c) : C(n)"
   320   by (erule Nat_ind) auto
   321 
   322 lemma lrecT:
   323   "[| l:List(A); b:C([]);
   324       !!x xs g.[| x:A;  xs:List(A); g:C(xs) |] ==> c(x,xs,g):C(x$xs) |] ==>
   325       lrec(l,b,c) : C(l)"
   326   by (erule List_ind) auto
   327 
   328 lemmas precTs = nrecT lrecT
   329 
   330 
   331 subsection {* Theorem proving *}
   332 
   333 lemma SgE2:
   334   "[| <a,b> : Sigma(A,B);  [| a:A;  b:B(a) |] ==> P |] ==> P"
   335   unfolding SgXH by blast
   336 
   337 (* General theorem proving ignores non-canonical term-formers,             *)
   338 (*         - intro rules are type rules for canonical terms                *)
   339 (*         - elim rules are case rules (no non-canonical terms appear)     *)
   340 
   341 ML {* bind_thms ("XHEs", XH_to_Es @{thms XHs}) *}
   342 
   343 lemmas [intro!] = SubtypeI canTs icanTs
   344   and [elim!] = SubtypeE XHEs
   345 
   346 
   347 subsection {* Infinite Data Types *}
   348 
   349 lemma lfp_subset_gfp: "mono(f) ==> lfp(f) <= gfp(f)"
   350   apply (rule lfp_lowerbound [THEN subset_trans])
   351    apply (erule gfp_lemma3)
   352   apply (rule subset_refl)
   353   done
   354 
   355 lemma gfpI:
   356   assumes "a:A"
   357     and "!!x X.[| x:A;  ALL y:A. t(y):X |] ==> t(x) : B(X)"
   358   shows "t(a) : gfp(B)"
   359   apply (rule coinduct)
   360    apply (rule_tac P = "%x. EX y:A. x=t (y)" in CollectI)
   361    apply (blast intro!: prems)+
   362   done
   363 
   364 lemma def_gfpI:
   365   "[| C==gfp(B);  a:A;  !!x X.[| x:A;  ALL y:A. t(y):X |] ==> t(x) : B(X) |] ==>
   366     t(a) : C"
   367   apply unfold
   368   apply (erule gfpI)
   369   apply blast
   370   done
   371 
   372 (* EG *)
   373 lemma "letrec g x be zero$g(x) in g(bot) : Lists(Nat)"
   374   apply (rule refl [THEN UnitXH [THEN iffD2], THEN Lists_def [THEN def_gfpI]])
   375   apply (subst letrecB)
   376   apply (unfold cons_def)
   377   apply blast
   378   done
   379 
   380 
   381 subsection {* Lemmas and tactics for using the rule @{text
   382   "coinduct3"} on @{text "[="} and @{text "="} *}
   383 
   384 lemma lfpI: "[| mono(f);  a : f(lfp(f)) |] ==> a : lfp(f)"
   385   apply (erule lfp_Tarski [THEN ssubst])
   386   apply assumption
   387   done
   388 
   389 lemma ssubst_single: "[| a=a';  a' : A |] ==> a : A"
   390   by simp
   391 
   392 lemma ssubst_pair: "[| a=a';  b=b';  <a',b'> : A |] ==> <a,b> : A"
   393   by simp
   394 
   395 
   396 ML {*
   397   val coinduct3_tac = SUBPROOF (fn {context = ctxt, prems = mono :: prems, ...} =>
   398     (fast_tac (claset_of ctxt addIs
   399         (mono RS @{thm coinduct3_mono_lemma} RS @{thm lfpI}) :: prems) 1));
   400 *}
   401 
   402 method_setup coinduct3 = {*
   403   Scan.succeed (SIMPLE_METHOD' o coinduct3_tac)
   404 *} ""
   405 
   406 lemma ci3_RI: "[| mono(Agen);  a : R |] ==> a : lfp(%x. Agen(x) Un R Un A)"
   407   by coinduct3
   408 
   409 lemma ci3_AgenI: "[| mono(Agen);  a : Agen(lfp(%x. Agen(x) Un R Un A)) |] ==>
   410     a : lfp(%x. Agen(x) Un R Un A)"
   411   by coinduct3
   412 
   413 lemma ci3_AI: "[| mono(Agen);  a : A |] ==> a : lfp(%x. Agen(x) Un R Un A)"
   414   by coinduct3
   415 
   416 ML {*
   417 fun genIs_tac ctxt genXH gen_mono =
   418   rtac (genXH RS iffD2) THEN'
   419   simp_tac (simpset_of ctxt) THEN'
   420   TRY o fast_tac (claset_of ctxt addIs
   421         [genXH RS iffD2, gen_mono RS @{thm coinduct3_mono_lemma} RS @{thm lfpI}])
   422 *}
   423 
   424 method_setup genIs = {*
   425   Attrib.thm -- Attrib.thm >> (fn (genXH, gen_mono) => fn ctxt =>
   426     SIMPLE_METHOD' (genIs_tac ctxt genXH gen_mono))
   427 *} ""
   428 
   429 
   430 subsection {* POgen *}
   431 
   432 lemma PO_refl: "<a,a> : PO"
   433   by (rule po_refl [THEN PO_iff [THEN iffD1]])
   434 
   435 lemma POgenIs:
   436   "<true,true> : POgen(R)"
   437   "<false,false> : POgen(R)"
   438   "[| <a,a'> : R;  <b,b'> : R |] ==> <<a,b>,<a',b'>> : POgen(R)"
   439   "!!b b'. [|!!x. <b(x),b'(x)> : R |] ==><lam x. b(x),lam x. b'(x)> : POgen(R)"
   440   "<one,one> : POgen(R)"
   441   "<a,a'> : lfp(%x. POgen(x) Un R Un PO) ==>
   442     <inl(a),inl(a')> : POgen(lfp(%x. POgen(x) Un R Un PO))"
   443   "<b,b'> : lfp(%x. POgen(x) Un R Un PO) ==>
   444     <inr(b),inr(b')> : POgen(lfp(%x. POgen(x) Un R Un PO))"
   445   "<zero,zero> : POgen(lfp(%x. POgen(x) Un R Un PO))"
   446   "<n,n'> : lfp(%x. POgen(x) Un R Un PO) ==>
   447     <succ(n),succ(n')> : POgen(lfp(%x. POgen(x) Un R Un PO))"
   448   "<[],[]> : POgen(lfp(%x. POgen(x) Un R Un PO))"
   449   "[| <h,h'> : lfp(%x. POgen(x) Un R Un PO);  <t,t'> : lfp(%x. POgen(x) Un R Un PO) |]
   450     ==> <h$t,h'$t'> : POgen(lfp(%x. POgen(x) Un R Un PO))"
   451   unfolding data_defs by (genIs POgenXH POgen_mono)+
   452 
   453 ML {*
   454 fun POgen_tac ctxt (rla, rlb) i =
   455   SELECT_GOAL (safe_tac (claset_of ctxt)) i THEN
   456   rtac (rlb RS (rla RS @{thm ssubst_pair})) i THEN
   457   (REPEAT (resolve_tac
   458       (@{thms POgenIs} @ [@{thm PO_refl} RS (@{thm POgen_mono} RS @{thm ci3_AI})] @
   459         (@{thms POgenIs} RL [@{thm POgen_mono} RS @{thm ci3_AgenI}]) @
   460         [@{thm POgen_mono} RS @{thm ci3_RI}]) i))
   461 *}
   462 
   463 
   464 subsection {* EQgen *}
   465 
   466 lemma EQ_refl: "<a,a> : EQ"
   467   by (rule refl [THEN EQ_iff [THEN iffD1]])
   468 
   469 lemma EQgenIs:
   470   "<true,true> : EQgen(R)"
   471   "<false,false> : EQgen(R)"
   472   "[| <a,a'> : R;  <b,b'> : R |] ==> <<a,b>,<a',b'>> : EQgen(R)"
   473   "!!b b'. [|!!x. <b(x),b'(x)> : R |] ==> <lam x. b(x),lam x. b'(x)> : EQgen(R)"
   474   "<one,one> : EQgen(R)"
   475   "<a,a'> : lfp(%x. EQgen(x) Un R Un EQ) ==>
   476     <inl(a),inl(a')> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))"
   477   "<b,b'> : lfp(%x. EQgen(x) Un R Un EQ) ==>
   478     <inr(b),inr(b')> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))"
   479   "<zero,zero> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))"
   480   "<n,n'> : lfp(%x. EQgen(x) Un R Un EQ) ==>
   481     <succ(n),succ(n')> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))"
   482   "<[],[]> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))"
   483   "[| <h,h'> : lfp(%x. EQgen(x) Un R Un EQ); <t,t'> : lfp(%x. EQgen(x) Un R Un EQ) |]
   484     ==> <h$t,h'$t'> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))"
   485   unfolding data_defs by (genIs EQgenXH EQgen_mono)+
   486 
   487 ML {*
   488 fun EQgen_raw_tac i =
   489   (REPEAT (resolve_tac (@{thms EQgenIs} @
   490         [@{thm EQ_refl} RS (@{thm EQgen_mono} RS @{thm ci3_AI})] @
   491         (@{thms EQgenIs} RL [@{thm EQgen_mono} RS @{thm ci3_AgenI}]) @
   492         [@{thm EQgen_mono} RS @{thm ci3_RI}]) i))
   493 
   494 (* Goals of the form R <= EQgen(R) - rewrite elements <a,b> : EQgen(R) using rews and *)
   495 (* then reduce this to a goal <a',b'> : R (hopefully?)                                *)
   496 (*      rews are rewrite rules that would cause looping in the simpifier              *)
   497 
   498 fun EQgen_tac ctxt rews i =
   499  SELECT_GOAL
   500    (TRY (safe_tac (claset_of ctxt)) THEN
   501     resolve_tac ((rews @ [@{thm refl}]) RL ((rews @ [@{thm refl}]) RL [@{thm ssubst_pair}])) i THEN
   502     ALLGOALS (simp_tac (simpset_of ctxt)) THEN
   503     ALLGOALS EQgen_raw_tac) i
   504 *}
   505 
   506 end