src/HOL/MiniML/Instance.ML
changeset 3018 e65b60b28341
parent 2625 69c1b8a493de
child 3842 b55686a7b22c
equal deleted inserted replaced
3017:84c2178db936 3018:e65b60b28341
    68 by (safe_tac (!claset));
    68 by (safe_tac (!claset));
    69 by (asm_simp_tac (!simpset setloop (split_tac [expand_if])) 1);
    69 by (asm_simp_tac (!simpset setloop (split_tac [expand_if])) 1);
    70 by (asm_simp_tac (!simpset setloop (split_tac [expand_if])) 1);
    70 by (asm_simp_tac (!simpset setloop (split_tac [expand_if])) 1);
    71 by (strip_tac 1);
    71 by (strip_tac 1);
    72 by (dres_inst_tac [("x","x")] bspec 1);
    72 by (dres_inst_tac [("x","x")] bspec 1);
    73 ba 1;
    73 by (assume_tac 1);
    74 by (dres_inst_tac [("x","x")] bspec 1);
    74 by (dres_inst_tac [("x","x")] bspec 1);
    75 by (Asm_simp_tac 1);
    75 by (Asm_simp_tac 1);
    76 by (Asm_full_simp_tac 1);
    76 by (Asm_full_simp_tac 1);
    77 qed_spec_mp "bound_scheme_inst_type";
    77 qed_spec_mp "bound_scheme_inst_type";
    78 
    78 
   108       "!!(sch::type_scheme) sch'. (sch' <= sch) = (? B. sch' = bound_scheme_inst B sch)";
   108       "!!(sch::type_scheme) sch'. (sch' <= sch) = (? B. sch' = bound_scheme_inst B sch)";
   109 by (rtac iffI 1);
   109 by (rtac iffI 1);
   110 by (cut_inst_tac [("sch","sch")] fresh_variable_type_schemes 1); 
   110 by (cut_inst_tac [("sch","sch")] fresh_variable_type_schemes 1); 
   111 by (cut_inst_tac [("sch","sch'")] fresh_variable_type_schemes 1);
   111 by (cut_inst_tac [("sch","sch'")] fresh_variable_type_schemes 1);
   112 by (dtac make_one_new_out_of_two 1);
   112 by (dtac make_one_new_out_of_two 1);
   113 ba 1;
   113 by (assume_tac 1);
   114 by (thin_tac "? n. new_tv n sch'" 1); 
   114 by (thin_tac "? n. new_tv n sch'" 1); 
   115 by (etac exE 1);
   115 by (etac exE 1);
   116 by (etac allE 1);
   116 by (etac allE 1);
   117 by (dtac mp 1);
   117 by (dtac mp 1);
   118 by (res_inst_tac [("x","(%k. TVar (k + n))")] exI 1);
   118 by (res_inst_tac [("x","(%k. TVar (k + n))")] exI 1);
   140 by (rtac exI 1);
   140 by (rtac exI 1);
   141 by (rtac mk_scheme_injective 1); 
   141 by (rtac mk_scheme_injective 1); 
   142 by (Asm_full_simp_tac 1);
   142 by (Asm_full_simp_tac 1);
   143 by (rotate_tac 1 1);
   143 by (rotate_tac 1 1);
   144 by (rtac mp 1);
   144 by (rtac mp 1);
   145 ba 2;
   145 by (assume_tac 2);
   146 by (type_scheme.induct_tac "sch" 1);
   146 by (type_scheme.induct_tac "sch" 1);
   147 by (Simp_tac 1);
   147 by (Simp_tac 1);
   148 by (Asm_full_simp_tac 1);
   148 by (Asm_full_simp_tac 1);
   149 by (Fast_tac 1);
   149 by (Fast_tac 1);
   150 by (strip_tac 1);
   150 by (strip_tac 1);
   158 by (Asm_full_simp_tac 1);
   158 by (Asm_full_simp_tac 1);
   159 qed_spec_mp "le_type_eq_is_bound_typ_instance";
   159 qed_spec_mp "le_type_eq_is_bound_typ_instance";
   160 
   160 
   161 goalw thy [le_env_def]
   161 goalw thy [le_env_def]
   162   "(sch # A <= sch' # B) = (sch <= (sch'::type_scheme) & A <= B)";
   162   "(sch # A <= sch' # B) = (sch <= (sch'::type_scheme) & A <= B)";
   163 by(Simp_tac 1);
   163 by (Simp_tac 1);
   164 br iffI 1;
   164 by (rtac iffI 1);
   165  by(SELECT_GOAL(safe_tac (!claset))1);
   165  by (SELECT_GOAL(safe_tac (!claset))1);
   166   by(eres_inst_tac [("x","0")] allE 1);
   166   by (eres_inst_tac [("x","0")] allE 1);
   167   by(Asm_full_simp_tac 1);
   167   by (Asm_full_simp_tac 1);
   168  by(eres_inst_tac [("x","Suc i")] allE 1);
   168  by (eres_inst_tac [("x","Suc i")] allE 1);
   169  by(Asm_full_simp_tac 1);
   169  by (Asm_full_simp_tac 1);
   170 br conjI 1;
   170 by (rtac conjI 1);
   171  by(Fast_tac 1);
   171  by (Fast_tac 1);
   172 br allI 1;
   172 by (rtac allI 1);
   173 by(nat_ind_tac "i" 1);
   173 by (nat_ind_tac "i" 1);
   174 by(ALLGOALS Asm_simp_tac);
   174 by (ALLGOALS Asm_simp_tac);
   175 qed "le_env_Cons";
   175 qed "le_env_Cons";
   176 AddIffs [le_env_Cons];
   176 AddIffs [le_env_Cons];
   177 
   177 
   178 goalw thy [is_bound_typ_instance]"!!t. t <| sch ==> $S t <| $S sch";
   178 goalw thy [is_bound_typ_instance]"!!t. t <| sch ==> $S t <| $S sch";
   179 by (etac exE 1);
   179 by (etac exE 1);
   194 by (simp_tac (!simpset addcongs [conj_cong]) 1);
   194 by (simp_tac (!simpset addcongs [conj_cong]) 1);
   195 by (fast_tac (!claset addSIs [S_compatible_le_scheme]) 1);
   195 by (fast_tac (!claset addSIs [S_compatible_le_scheme]) 1);
   196 qed "S_compatible_le_scheme_lists";
   196 qed "S_compatible_le_scheme_lists";
   197 
   197 
   198 goalw thy [le_type_scheme_def] "!!t.[| t <| sch; sch <= sch' |] ==> t <| sch'";
   198 goalw thy [le_type_scheme_def] "!!t.[| t <| sch; sch <= sch' |] ==> t <| sch'";
   199 by(Fast_tac 1);
   199 by (Fast_tac 1);
   200 qed "bound_typ_instance_trans";
   200 qed "bound_typ_instance_trans";
   201 
   201 
   202 goalw thy [le_type_scheme_def] "sch <= (sch::type_scheme)";
   202 goalw thy [le_type_scheme_def] "sch <= (sch::type_scheme)";
   203 by(Fast_tac 1);
   203 by (Fast_tac 1);
   204 qed "le_type_scheme_refl";
   204 qed "le_type_scheme_refl";
   205 AddIffs [le_type_scheme_refl];
   205 AddIffs [le_type_scheme_refl];
   206 
   206 
   207 goalw thy [le_env_def] "A <= (A::type_scheme list)";
   207 goalw thy [le_env_def] "A <= (A::type_scheme list)";
   208 by(Fast_tac 1);
   208 by (Fast_tac 1);
   209 qed "le_env_refl";
   209 qed "le_env_refl";
   210 AddIffs [le_env_refl];
   210 AddIffs [le_env_refl];
   211 
   211 
   212 goalw thy [le_type_scheme_def,is_bound_typ_instance] "sch <= BVar n";
   212 goalw thy [le_type_scheme_def,is_bound_typ_instance] "sch <= BVar n";
   213 by(strip_tac 1);
   213 by (strip_tac 1);
   214 by(res_inst_tac [("x","%a.t")]exI 1);
   214 by (res_inst_tac [("x","%a.t")]exI 1);
   215 by(Simp_tac 1);
   215 by (Simp_tac 1);
   216 qed "bound_typ_instance_BVar";
   216 qed "bound_typ_instance_BVar";
   217 AddIffs [bound_typ_instance_BVar];
   217 AddIffs [bound_typ_instance_BVar];
   218 
   218 
   219 goalw thy [le_type_scheme_def,is_bound_typ_instance] "(sch <= FVar n) = (sch = FVar n)";
   219 goalw thy [le_type_scheme_def,is_bound_typ_instance] "(sch <= FVar n) = (sch = FVar n)";
   220 by(type_scheme.induct_tac "sch" 1);
   220 by (type_scheme.induct_tac "sch" 1);
   221   by(Simp_tac 1);
   221   by (Simp_tac 1);
   222  by(Simp_tac 1);
   222  by (Simp_tac 1);
   223  by(SELECT_GOAL(safe_tac(!claset))1);
   223  by (SELECT_GOAL(safe_tac(!claset))1);
   224  by(eres_inst_tac [("x","TVar n -> TVar n")] allE 1);
   224  by (eres_inst_tac [("x","TVar n -> TVar n")] allE 1);
   225  by(Asm_full_simp_tac 1);
   225  by (Asm_full_simp_tac 1);
   226  by(Fast_tac 1);
   226  by (Fast_tac 1);
   227 by(Asm_full_simp_tac 1);
   227 by (Asm_full_simp_tac 1);
   228 br iffI 1;
   228 by (rtac iffI 1);
   229  by(eres_inst_tac [("x","bound_typ_inst S type_scheme1 -> bound_typ_inst S type_scheme2")] allE 1);
   229  by (eres_inst_tac [("x","bound_typ_inst S type_scheme1 -> bound_typ_inst S type_scheme2")] allE 1);
   230  by(Asm_full_simp_tac 1);
   230  by (Asm_full_simp_tac 1);
   231  by(Fast_tac 1);
   231  by (Fast_tac 1);
   232 by(Fast_tac 1);
   232 by (Fast_tac 1);
   233 qed "le_FVar";
   233 qed "le_FVar";
   234 Addsimps [le_FVar];
   234 Addsimps [le_FVar];
   235 
   235 
   236 goalw thy [le_type_scheme_def,is_bound_typ_instance] "~(FVar n <= sch1 =-> sch2)";
   236 goalw thy [le_type_scheme_def,is_bound_typ_instance] "~(FVar n <= sch1 =-> sch2)";
   237 by(Simp_tac 1);
   237 by (Simp_tac 1);
   238 qed "not_FVar_le_Fun";
   238 qed "not_FVar_le_Fun";
   239 AddIffs [not_FVar_le_Fun];
   239 AddIffs [not_FVar_le_Fun];
   240 
   240 
   241 goalw thy [le_type_scheme_def,is_bound_typ_instance] "~(BVar n <= sch1 =-> sch2)";
   241 goalw thy [le_type_scheme_def,is_bound_typ_instance] "~(BVar n <= sch1 =-> sch2)";
   242 by(Simp_tac 1);
   242 by (Simp_tac 1);
   243 by(res_inst_tac [("x","TVar n")] exI 1);
   243 by (res_inst_tac [("x","TVar n")] exI 1);
   244 by(Simp_tac 1);
   244 by (Simp_tac 1);
   245 by(Fast_tac 1);
   245 by (Fast_tac 1);
   246 qed "not_BVar_le_Fun";
   246 qed "not_BVar_le_Fun";
   247 AddIffs [not_BVar_le_Fun];
   247 AddIffs [not_BVar_le_Fun];
   248 
   248 
   249 goalw thy [le_type_scheme_def,is_bound_typ_instance]
   249 goalw thy [le_type_scheme_def,is_bound_typ_instance]
   250   "!!sch1. (sch1 =-> sch2 <= sch1' =-> sch2') ==> sch1 <= sch1' & sch2 <= sch2'";
   250   "!!sch1. (sch1 =-> sch2 <= sch1' =-> sch2') ==> sch1 <= sch1' & sch2 <= sch2'";
   251 by(fast_tac (!claset addss !simpset) 1);
   251 by (fast_tac (!claset addss !simpset) 1);
   252 qed "Fun_le_FunD";
   252 qed "Fun_le_FunD";
   253 
   253 
   254 goal thy "(sch' <= sch1 =-> sch2) --> (? sch'1 sch'2. sch' = sch'1 =-> sch'2)";
   254 goal thy "(sch' <= sch1 =-> sch2) --> (? sch'1 sch'2. sch' = sch'1 =-> sch'2)";
   255 by (type_scheme.induct_tac "sch'" 1);
   255 by (type_scheme.induct_tac "sch'" 1);
   256 by (Asm_simp_tac 1);
   256 by (Asm_simp_tac 1);
   257 by (Asm_simp_tac 1);
   257 by (Asm_simp_tac 1);
   258 by (Fast_tac 1);
   258 by (Fast_tac 1);
   259 qed_spec_mp "scheme_le_Fun";
   259 qed_spec_mp "scheme_le_Fun";
   260 
   260 
   261 goal thy "!sch'::type_scheme. sch <= sch' --> free_tv sch' <= free_tv sch";
   261 goal thy "!sch'::type_scheme. sch <= sch' --> free_tv sch' <= free_tv sch";
   262 by(type_scheme.induct_tac "sch" 1);
   262 by (type_scheme.induct_tac "sch" 1);
   263   br allI 1;
   263   by (rtac allI 1);
   264   by(type_scheme.induct_tac "sch'" 1);
   264   by (type_scheme.induct_tac "sch'" 1);
   265     by(Simp_tac 1);
   265     by (Simp_tac 1);
   266    by(Simp_tac 1);
   266    by (Simp_tac 1);
   267   by(Simp_tac 1);
   267   by (Simp_tac 1);
   268  br allI 1;
   268  by (rtac allI 1);
   269  by(type_scheme.induct_tac "sch'" 1);
   269  by (type_scheme.induct_tac "sch'" 1);
   270    by(Simp_tac 1);
   270    by (Simp_tac 1);
   271   by(Simp_tac 1);
   271   by (Simp_tac 1);
   272  by(Simp_tac 1);
   272  by (Simp_tac 1);
   273 br allI 1;
   273 by (rtac allI 1);
   274 by(type_scheme.induct_tac "sch'" 1);
   274 by (type_scheme.induct_tac "sch'" 1);
   275   by(Simp_tac 1);
   275   by (Simp_tac 1);
   276  by(Simp_tac 1);
   276  by (Simp_tac 1);
   277 by(Asm_full_simp_tac 1);
   277 by (Asm_full_simp_tac 1);
   278 by(strip_tac 1);
   278 by (strip_tac 1);
   279 bd Fun_le_FunD 1;
   279 by (dtac Fun_le_FunD 1);
   280 by(Fast_tac 1);
   280 by (Fast_tac 1);
   281 qed_spec_mp "le_type_scheme_free_tv";
   281 qed_spec_mp "le_type_scheme_free_tv";
   282 
   282 
   283 goal thy "!A::type_scheme list. A <= B --> free_tv B <= free_tv A";
   283 goal thy "!A::type_scheme list. A <= B --> free_tv B <= free_tv A";
   284 by(list.induct_tac "B" 1);
   284 by (list.induct_tac "B" 1);
   285  by(Simp_tac 1);
   285  by (Simp_tac 1);
   286 br allI 1;
   286 by (rtac allI 1);
   287 by(list.induct_tac "A" 1);
   287 by (list.induct_tac "A" 1);
   288  by(simp_tac (!simpset addsimps [le_env_def]) 1);
   288  by (simp_tac (!simpset addsimps [le_env_def]) 1);
   289 by(Simp_tac 1);
   289 by (Simp_tac 1);
   290 by(fast_tac (!claset addDs [le_type_scheme_free_tv]) 1);
   290 by (fast_tac (!claset addDs [le_type_scheme_free_tv]) 1);
   291 qed_spec_mp "le_env_free_tv";
   291 qed_spec_mp "le_env_free_tv";