src/ZF/InfDatatype.ML
changeset 516 1957113f0d7d
parent 488 52f7447d4f1b
child 517 a9f93400f307
equal deleted inserted replaced
515:abcc438e7c27 516:1957113f0d7d
     1 (*  Title: 	ZF/InfDatatype.ML
     1 (*  Title: 	ZF/InfDatatype.ML
     2     ID:         $Id$
     2     ID:         $Id$
     3     Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
     3     Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
     4     Copyright   1994  University of Cambridge
     4     Copyright   1994  University of Cambridge
     5 
     5 
     6 Infinite-Branching Datatype Definitions
     6 Datatype Definitions involving ->
       
     7 	Even infinite-branching!
     7 *)
     8 *)
       
     9 
       
    10 (*** Closure under finite powerset ***)
       
    11 
       
    12 val Fin_Univ_thy = merge_theories (Univ.thy,Finite.thy);
       
    13 
       
    14 goal Fin_Univ_thy
       
    15    "!!i. [| b: Fin(Vfrom(A,i));  Limit(i) |] ==> EX j. b <= Vfrom(A,j) & j<i";
       
    16 by (eresolve_tac [Fin_induct] 1);
       
    17 by (fast_tac (ZF_cs addSDs [Limit_has_0]) 1);
       
    18 by (safe_tac ZF_cs);
       
    19 by (eresolve_tac [Limit_VfromE] 1);
       
    20 by (assume_tac 1);
       
    21 by (res_inst_tac [("x", "xa Un j")] exI 1);
       
    22 by (best_tac (ZF_cs addIs [subset_refl RS Vfrom_mono RS subsetD, 
       
    23 			   Un_least_lt]) 1);
       
    24 val Fin_Vfrom_lemma = result();
       
    25 
       
    26 goal Fin_Univ_thy "!!i. Limit(i) ==> Fin(Vfrom(A,i)) <= Vfrom(A,i)";
       
    27 by (rtac subsetI 1);
       
    28 by (dresolve_tac [Fin_Vfrom_lemma] 1);
       
    29 by (safe_tac ZF_cs);
       
    30 by (resolve_tac [Vfrom RS ssubst] 1);
       
    31 by (fast_tac (ZF_cs addSDs [ltD]) 1);
       
    32 val Fin_VLimit = result();
       
    33 
       
    34 val Fin_subset_VLimit = 
       
    35     [Fin_mono, Fin_VLimit] MRS subset_trans |> standard;
       
    36 
       
    37 goal Fin_Univ_thy
       
    38     "!!i. [| n: nat;  Limit(i) |] ==> n -> Vfrom(A,i) <= Vfrom(A,i)";
       
    39 by (eresolve_tac [nat_fun_subset_Fin RS subset_trans] 1);
       
    40 by (REPEAT (ares_tac [Fin_subset_VLimit, Sigma_subset_VLimit,
       
    41 		      nat_subset_VLimit, subset_refl] 1));
       
    42 val nat_fun_VLimit = result();
       
    43 
       
    44 val nat_fun_subset_VLimit = 
       
    45     [Pi_mono, nat_fun_VLimit] MRS subset_trans |> standard;
       
    46 
       
    47 
       
    48 goalw Fin_Univ_thy [univ_def] "Fin(univ(A)) <= univ(A)";
       
    49 by (rtac (Limit_nat RS Fin_VLimit) 1);
       
    50 val Fin_univ = result();
       
    51 
       
    52 val Fin_subset_univ = [Fin_mono, Fin_univ] MRS subset_trans |> standard;
       
    53 
       
    54 goalw Fin_Univ_thy [univ_def] "!!i. n: nat ==> n -> univ(A) <= univ(A)";
       
    55 by (etac (Limit_nat RSN (2,nat_fun_VLimit)) 1);
       
    56 val nat_fun_univ = result();
       
    57 
       
    58 val nat_fun_subset_univ = [Pi_mono, nat_fun_univ] MRS subset_trans |> standard;
       
    59 
       
    60 goal Fin_Univ_thy
       
    61     "!!f. [| f: n -> B;  B <= univ(A);  n : nat |] ==> f : univ(A)";
       
    62 by (REPEAT (ares_tac [nat_fun_subset_univ RS subsetD] 1));
       
    63 val nat_fun_into_univ = result();
       
    64 
       
    65 
       
    66 (*** Infinite branching ***)
     8 
    67 
     9 val fun_Limit_VfromE = 
    68 val fun_Limit_VfromE = 
    10     [apply_funtype, InfCard_csucc RS InfCard_is_Limit] MRS Limit_VfromE
    69     [apply_funtype, InfCard_csucc RS InfCard_is_Limit] MRS Limit_VfromE
    11 	|> standard;
    70 	|> standard;
       
    71 
       
    72 goal InfDatatype.thy
       
    73     "!!K. [| f: I -> Vfrom(A,csucc(K));  |I| le K;  InfCard(K)	\
       
    74 \         |] ==> EX j. f: I -> Vfrom(A,j) & j < csucc(K)";
       
    75 by (res_inst_tac [("x", "UN x:I. LEAST i. f`x : Vfrom(A,i)")] exI 1);
       
    76 by (resolve_tac [conjI] 1);
       
    77 by (resolve_tac [ballI RSN (2,cardinal_UN_Ord_lt_csucc)] 2);
       
    78 by (eresolve_tac [fun_Limit_VfromE] 3 THEN REPEAT_SOME assume_tac);
       
    79 by (fast_tac (ZF_cs addEs [Least_le RS lt_trans1, ltE]) 2);
       
    80 by (resolve_tac [Pi_type] 1);
       
    81 by (rename_tac "k" 2);
       
    82 by (eresolve_tac [fun_Limit_VfromE] 2 THEN REPEAT_SOME assume_tac);
       
    83 by (subgoal_tac "f`k : Vfrom(A, LEAST i. f`k : Vfrom(A,i))" 1);
       
    84 by (fast_tac (ZF_cs addEs [LeastI, ltE]) 2);
       
    85 by (eresolve_tac [[subset_refl, UN_upper] MRS Vfrom_mono RS subsetD] 1);
       
    86 by (assume_tac 1);
       
    87 val fun_Vcsucc_lemma = result();
    12 
    88 
    13 goal InfDatatype.thy
    89 goal InfDatatype.thy
    14     "!!K. [| f: K -> Vfrom(A,csucc(K));  InfCard(K)	\
    90     "!!K. [| f: K -> Vfrom(A,csucc(K));  InfCard(K)	\
    15 \         |] ==> EX j. f: K -> Vfrom(A,j) & j < csucc(K)";
    91 \         |] ==> EX j. f: K -> Vfrom(A,j) & j < csucc(K)";
    16 by (res_inst_tac [("x", "UN k:K. LEAST i. f`k : Vfrom(A,i)")] exI 1);
    92 by (res_inst_tac [("x", "UN k:K. LEAST i. f`k : Vfrom(A,i)")] exI 1);
    23 by (eresolve_tac [fun_Limit_VfromE] 2 THEN REPEAT_SOME assume_tac);
    99 by (eresolve_tac [fun_Limit_VfromE] 2 THEN REPEAT_SOME assume_tac);
    24 by (subgoal_tac "f`k : Vfrom(A, LEAST i. f`k : Vfrom(A,i))" 1);
   100 by (subgoal_tac "f`k : Vfrom(A, LEAST i. f`k : Vfrom(A,i))" 1);
    25 by (fast_tac (ZF_cs addEs [LeastI, ltE]) 2);
   101 by (fast_tac (ZF_cs addEs [LeastI, ltE]) 2);
    26 by (eresolve_tac [[subset_refl, UN_upper] MRS Vfrom_mono RS subsetD] 1);
   102 by (eresolve_tac [[subset_refl, UN_upper] MRS Vfrom_mono RS subsetD] 1);
    27 by (assume_tac 1);
   103 by (assume_tac 1);
    28 val fun_Vfrom_csucc_lemma = result();
   104 val fun_Vcsucc_lemma = result();
    29 
   105 
    30 goal InfDatatype.thy
   106 goal InfDatatype.thy
    31     "!!K. InfCard(K) ==> K -> Vfrom(A,csucc(K)) <= Vfrom(A,csucc(K))";
   107     "!!K. InfCard(K) ==> K -> Vfrom(A,csucc(K)) <= Vfrom(A,csucc(K))";
    32 by (safe_tac (ZF_cs addSDs [fun_Vfrom_csucc_lemma]));
   108 by (safe_tac (ZF_cs addSDs [fun_Vcsucc_lemma]));
    33 by (resolve_tac [Vfrom RS ssubst] 1);
   109 by (resolve_tac [Vfrom RS ssubst] 1);
    34 by (eresolve_tac [PiE] 1);
   110 by (eresolve_tac [PiE] 1);
    35 (*This level includes the function, and is below csucc(K)*)
   111 (*This level includes the function, and is below csucc(K)*)
    36 by (res_inst_tac [("a1", "succ(succ(K Un j))")] (UN_I RS UnI2) 1);
   112 by (res_inst_tac [("a1", "succ(succ(K Un j))")] (UN_I RS UnI2) 1);
    37 by (eresolve_tac [subset_trans RS PowI] 2);
   113 by (eresolve_tac [subset_trans RS PowI] 2);
    40 by (eresolve_tac [[subset_refl, Un_upper2] MRS Vfrom_mono RS subsetD] 2);
   116 by (eresolve_tac [[subset_refl, Un_upper2] MRS Vfrom_mono RS subsetD] 2);
    41 by (REPEAT (ares_tac [ltD, InfCard_csucc, InfCard_is_Limit, 
   117 by (REPEAT (ares_tac [ltD, InfCard_csucc, InfCard_is_Limit, 
    42 		      Limit_has_succ, Un_least_lt] 1));
   118 		      Limit_has_succ, Un_least_lt] 1));
    43 by (eresolve_tac [InfCard_is_Card RS Card_is_Ord RS lt_csucc] 1);
   119 by (eresolve_tac [InfCard_is_Card RS Card_is_Ord RS lt_csucc] 1);
    44 by (assume_tac 1);
   120 by (assume_tac 1);
    45 val fun_Vfrom_csucc = result();
   121 val fun_Vcsucc = result();
    46 
   122 
    47 goal InfDatatype.thy
   123 goal InfDatatype.thy
    48     "!!K. [| f: K -> Vfrom(A, csucc(K));  InfCard(K) \
   124     "!!K. [| f: K -> Vfrom(A, csucc(K));  InfCard(K) \
    49 \         |] ==> f: Vfrom(A,csucc(K))";
   125 \         |] ==> f: Vfrom(A,csucc(K))";
    50 by (REPEAT (ares_tac [fun_Vfrom_csucc RS subsetD] 1));
   126 by (REPEAT (ares_tac [fun_Vcsucc RS subsetD] 1));
    51 val fun_in_Vfrom_csucc = result();
   127 val fun_in_Vcsucc = result();
    52 
   128 
    53 val fun_subset_Vfrom_csucc = 
   129 val fun_subset_Vcsucc = 
    54 	[Pi_mono, fun_Vfrom_csucc] MRS subset_trans |> standard;
   130 	[Pi_mono, fun_Vcsucc] MRS subset_trans |> standard;
    55 
   131 
    56 goal InfDatatype.thy
   132 goal InfDatatype.thy
    57     "!!f. [| f: K -> B;  B <= Vfrom(A,csucc(K));  InfCard(K) \
   133     "!!f. [| f: K -> B;  B <= Vfrom(A,csucc(K));  InfCard(K) \
    58 \         |] ==> f: Vfrom(A,csucc(K))";
   134 \         |] ==> f: Vfrom(A,csucc(K))";
    59 by (REPEAT (ares_tac [fun_subset_Vfrom_csucc RS subsetD] 1));
   135 by (REPEAT (ares_tac [fun_subset_Vcsucc RS subsetD] 1));
    60 val fun_into_Vfrom_csucc = result();
   136 val fun_into_Vcsucc = result();
    61 
   137 
    62 val Limit_csucc = InfCard_csucc RS InfCard_is_Limit |> standard;
   138 val Limit_csucc = InfCard_csucc RS InfCard_is_Limit |> standard;
    63 
   139 
    64 val Pair_in_Vfrom_csucc = Limit_csucc RSN (3, Pair_in_Vfrom_Limit) |> standard;
   140 val Pair_in_Vcsucc = Limit_csucc RSN (3, Pair_in_VLimit) |> standard;
    65 val Inl_in_Vfrom_csucc  = Limit_csucc RSN (2, Inl_in_Vfrom_Limit) |> standard;
   141 val Inl_in_Vcsucc  = Limit_csucc RSN (2, Inl_in_VLimit) |> standard;
    66 val Inr_in_Vfrom_csucc  = Limit_csucc RSN (2, Inr_in_Vfrom_Limit) |> standard;
   142 val Inr_in_Vcsucc  = Limit_csucc RSN (2, Inr_in_VLimit) |> standard;
    67 val zero_in_Vfrom_csucc = Limit_csucc RS zero_in_Vfrom_Limit |> standard;
   143 val zero_in_Vcsucc = Limit_csucc RS zero_in_VLimit |> standard;
    68 val nat_into_Vfrom_csucc = Limit_csucc RSN (2, nat_into_Vfrom_Limit) 
   144 val nat_into_Vcsucc = Limit_csucc RSN (2, nat_into_VLimit) |> standard;
    69 			   |> standard;
       
    70 
   145 
    71 (*For most K-branching datatypes with domain Vfrom(A, csucc(K)) *)
   146 (*For most K-branching datatypes with domain Vfrom(A, csucc(K)) *)
    72 val inf_datatype_intrs =  
   147 val inf_datatype_intrs =  
    73     [fun_in_Vfrom_csucc, InfCard_nat, Pair_in_Vfrom_csucc, 
   148     [fun_in_Vcsucc, InfCard_nat, Pair_in_Vcsucc, 
    74      Inl_in_Vfrom_csucc, Inr_in_Vfrom_csucc, 
   149      Inl_in_Vcsucc, Inr_in_Vcsucc, 
    75      zero_in_Vfrom_csucc, A_into_Vfrom, nat_into_Vfrom_csucc] @ datatype_intrs;
   150      zero_in_Vcsucc, A_into_Vfrom, nat_into_Vcsucc] @ datatype_intrs;
    76 
   151