equal
deleted
inserted
replaced
196 @{thm comp_single_set_bd} OF [nth inner_bd_Card_orders j, nth (nth inner_set_bdss j) i, |
196 @{thm comp_single_set_bd} OF [nth inner_bd_Card_orders j, nth (nth inner_set_bdss j) i, |
197 nth outer_set_bds j] |
197 nth outer_set_bds j] |
198 val single_set_bd_thmss = |
198 val single_set_bd_thmss = |
199 map ((fn f => map f (0 upto olive - 1)) o single_set_bd_thm) (0 upto ilive - 1); |
199 map ((fn f => map f (0 upto olive - 1)) o single_set_bd_thm) (0 upto ilive - 1); |
200 in |
200 in |
201 map2 (fn set_alt => fn single_set_bds => fn {context = ctxt, prems = _} => |
201 map2 (fn set_alt => fn single_set_bds => fn ctxt => |
202 mk_comp_set_bd_tac ctxt set_alt single_set_bds) |
202 mk_comp_set_bd_tac ctxt set_alt single_set_bds) |
203 set_alt_thms single_set_bd_thmss |
203 set_alt_thms single_set_bd_thmss |
204 end; |
204 end; |
205 |
205 |
206 val in_alt_thm = |
206 val in_alt_thm = |
249 |> flat |
249 |> flat |
250 |> map (`(fn t => Term.add_frees t [])) |
250 |> map (`(fn t => Term.add_frees t [])) |
251 |> minimize_wits |
251 |> minimize_wits |
252 |> map (fn (frees, t) => fold absfree frees t); |
252 |> map (fn (frees, t) => fold absfree frees t); |
253 |
253 |
254 fun wit_tac {context = ctxt, prems = _} = |
254 fun wit_tac ctxt = |
255 mk_comp_wit_tac ctxt (wit_thms_of_bnf outer) (collect_set_map_of_bnf outer) |
255 mk_comp_wit_tac ctxt (wit_thms_of_bnf outer) (collect_set_map_of_bnf outer) |
256 (maps wit_thms_of_bnf inners); |
256 (maps wit_thms_of_bnf inners); |
257 |
257 |
258 val (bnf', lthy') = |
258 val (bnf', lthy') = |
259 bnf_def const_policy (K Dont_Note) qualify tacs wit_tac (SOME (oDs @ flat Dss)) Binding.empty |
259 bnf_def const_policy (K Dont_Note) qualify tacs wit_tac (SOME (oDs @ flat Dss)) Binding.empty |
299 val bnf_bd = mk_bd_of_bnf Ds As bnf; |
299 val bnf_bd = mk_bd_of_bnf Ds As bnf; |
300 val bd = mk_cprod |
300 val bd = mk_cprod |
301 (Library.foldr1 (uncurry mk_csum) (map (mk_card_of o HOLogic.mk_UNIV) killedAs)) bnf_bd; |
301 (Library.foldr1 (uncurry mk_csum) (map (mk_card_of o HOLogic.mk_UNIV) killedAs)) bnf_bd; |
302 |
302 |
303 fun map_id0_tac _ = rtac (map_id0_of_bnf bnf) 1; |
303 fun map_id0_tac _ = rtac (map_id0_of_bnf bnf) 1; |
304 fun map_comp0_tac {context = ctxt, prems = _} = |
304 fun map_comp0_tac ctxt = |
305 unfold_thms_tac ctxt ((map_comp0_of_bnf bnf RS sym) :: |
305 unfold_thms_tac ctxt ((map_comp0_of_bnf bnf RS sym) :: |
306 @{thms comp_assoc id_comp comp_id}) THEN rtac refl 1; |
306 @{thms comp_assoc id_comp comp_id}) THEN rtac refl 1; |
307 fun map_cong0_tac {context = ctxt, prems = _} = |
307 fun map_cong0_tac ctxt = |
308 mk_kill_map_cong0_tac ctxt n (live - n) (map_cong0_of_bnf bnf); |
308 mk_kill_map_cong0_tac ctxt n (live - n) (map_cong0_of_bnf bnf); |
309 val set_map0_tacs = map (fn thm => fn _ => rtac thm 1) (drop n (set_map0_of_bnf bnf)); |
309 val set_map0_tacs = map (fn thm => fn _ => rtac thm 1) (drop n (set_map0_of_bnf bnf)); |
310 fun bd_card_order_tac _ = mk_kill_bd_card_order_tac n (bd_card_order_of_bnf bnf); |
310 fun bd_card_order_tac _ = mk_kill_bd_card_order_tac n (bd_card_order_of_bnf bnf); |
311 fun bd_cinfinite_tac _ = mk_kill_bd_cinfinite_tac (bd_Cinfinite_of_bnf bnf); |
311 fun bd_cinfinite_tac _ = mk_kill_bd_cinfinite_tac (bd_Cinfinite_of_bnf bnf); |
312 val set_bd_tacs = |
312 val set_bd_tacs = |
320 val goal = fold_rev Logic.all Asets (mk_Trueprop_eq (inx, in_alt)); |
320 val goal = fold_rev Logic.all Asets (mk_Trueprop_eq (inx, in_alt)); |
321 in |
321 in |
322 Goal.prove_sorry lthy [] [] goal (K kill_in_alt_tac) |> Thm.close_derivation |
322 Goal.prove_sorry lthy [] [] goal (K kill_in_alt_tac) |> Thm.close_derivation |
323 end; |
323 end; |
324 |
324 |
325 fun le_rel_OO_tac {context = ctxt, prems = _} = |
325 fun le_rel_OO_tac ctxt = |
326 EVERY' [rtac @{thm ord_le_eq_trans}, rtac (le_rel_OO_of_bnf bnf)] 1 THEN |
326 EVERY' [rtac @{thm ord_le_eq_trans}, rtac (le_rel_OO_of_bnf bnf)] 1 THEN |
327 unfold_thms_tac ctxt @{thms eq_OO} THEN rtac refl 1; |
327 unfold_thms_tac ctxt @{thms eq_OO} THEN rtac refl 1; |
328 |
328 |
329 fun rel_OO_Grp_tac _ = |
329 fun rel_OO_Grp_tac _ = |
330 let |
330 let |
391 val sets = map (fn A => absdummy T (HOLogic.mk_set A [])) newAs @ bnf_sets; |
391 val sets = map (fn A => absdummy T (HOLogic.mk_set A [])) newAs @ bnf_sets; |
392 |
392 |
393 val bd = mk_bd_of_bnf Ds As bnf; |
393 val bd = mk_bd_of_bnf Ds As bnf; |
394 |
394 |
395 fun map_id0_tac _ = rtac (map_id0_of_bnf bnf) 1; |
395 fun map_id0_tac _ = rtac (map_id0_of_bnf bnf) 1; |
396 fun map_comp0_tac {context = ctxt, prems = _} = |
396 fun map_comp0_tac ctxt = |
397 unfold_thms_tac ctxt ((map_comp0_of_bnf bnf RS sym) :: |
397 unfold_thms_tac ctxt ((map_comp0_of_bnf bnf RS sym) :: |
398 @{thms comp_assoc id_comp comp_id}) THEN rtac refl 1; |
398 @{thms comp_assoc id_comp comp_id}) THEN rtac refl 1; |
399 fun map_cong0_tac {context = ctxt, prems = _} = |
399 fun map_cong0_tac ctxt = |
400 rtac (map_cong0_of_bnf bnf) 1 THEN REPEAT_DETERM_N live (Goal.assume_rule_tac ctxt 1); |
400 rtac (map_cong0_of_bnf bnf) 1 THEN REPEAT_DETERM_N live (Goal.assume_rule_tac ctxt 1); |
401 val set_map0_tacs = |
401 val set_map0_tacs = |
402 if Config.get lthy quick_and_dirty then |
402 if Config.get lthy quick_and_dirty then |
403 replicate (n + live) (K all_tac) |
403 replicate (n + live) (K all_tac) |
404 else |
404 else |
476 |
476 |
477 val bd = mk_bd_of_bnf Ds As bnf; |
477 val bd = mk_bd_of_bnf Ds As bnf; |
478 |
478 |
479 fun map_id0_tac _ = rtac (map_id0_of_bnf bnf) 1; |
479 fun map_id0_tac _ = rtac (map_id0_of_bnf bnf) 1; |
480 fun map_comp0_tac _ = rtac (map_comp0_of_bnf bnf) 1; |
480 fun map_comp0_tac _ = rtac (map_comp0_of_bnf bnf) 1; |
481 fun map_cong0_tac {context = ctxt, prems = _} = |
481 fun map_cong0_tac ctxt = |
482 rtac (map_cong0_of_bnf bnf) 1 THEN REPEAT_DETERM_N live (Goal.assume_rule_tac ctxt 1); |
482 rtac (map_cong0_of_bnf bnf) 1 THEN REPEAT_DETERM_N live (Goal.assume_rule_tac ctxt 1); |
483 val set_map0_tacs = permute (map (fn thm => fn _ => rtac thm 1) (set_map0_of_bnf bnf)); |
483 val set_map0_tacs = permute (map (fn thm => fn _ => rtac thm 1) (set_map0_of_bnf bnf)); |
484 fun bd_card_order_tac _ = rtac (bd_card_order_of_bnf bnf) 1; |
484 fun bd_card_order_tac _ = rtac (bd_card_order_of_bnf bnf) 1; |
485 fun bd_cinfinite_tac _ = rtac (bd_cinfinite_of_bnf bnf) 1; |
485 fun bd_cinfinite_tac _ = rtac (bd_cinfinite_of_bnf bnf) 1; |
486 val set_bd_tacs = permute (map (fn thm => fn _ => rtac thm 1) (set_bd_of_bnf bnf)); |
486 val set_bd_tacs = permute (map (fn thm => fn _ => rtac thm 1) (set_bd_of_bnf bnf)); |
626 (@{thm Cinfinite_cong} OF [bd_ordIso, bd_Cinfinite_of_bnf bnf]) RS conjunct1; |
626 (@{thm Cinfinite_cong} OF [bd_ordIso, bd_Cinfinite_of_bnf bnf]) RS conjunct1; |
627 |
627 |
628 val set_bds = |
628 val set_bds = |
629 map (fn thm => @{thm ordLeq_ordIso_trans} OF [thm, bd_ordIso]) (set_bd_of_bnf bnf); |
629 map (fn thm => @{thm ordLeq_ordIso_trans} OF [thm, bd_ordIso]) (set_bd_of_bnf bnf); |
630 |
630 |
631 fun mk_tac thm {context = ctxt, prems = _} = |
631 fun mk_tac thm ctxt = |
632 (rtac (unfold_all ctxt thm) THEN' |
632 (rtac (unfold_all ctxt thm) THEN' |
633 SOLVE o REPEAT_DETERM o (atac ORELSE' Goal.assume_rule_tac ctxt)) 1; |
633 SOLVE o REPEAT_DETERM o (atac ORELSE' Goal.assume_rule_tac ctxt)) 1; |
634 |
634 |
635 val tacs = zip_axioms (mk_tac (map_id0_of_bnf bnf)) (mk_tac (map_comp0_of_bnf bnf)) |
635 val tacs = zip_axioms (mk_tac (map_id0_of_bnf bnf)) (mk_tac (map_comp0_of_bnf bnf)) |
636 (mk_tac (map_cong0_of_bnf bnf)) (map mk_tac (set_map0_of_bnf bnf)) |
636 (mk_tac (map_cong0_of_bnf bnf)) (map mk_tac (set_map0_of_bnf bnf)) |
638 (mk_tac (le_rel_OO_of_bnf bnf)) |
638 (mk_tac (le_rel_OO_of_bnf bnf)) |
639 (mk_tac (rel_OO_Grp_of_bnf bnf)); |
639 (mk_tac (rel_OO_Grp_of_bnf bnf)); |
640 |
640 |
641 val bnf_wits = map snd (mk_wits_of_bnf (replicate nwits Ds) (replicate nwits As) bnf); |
641 val bnf_wits = map snd (mk_wits_of_bnf (replicate nwits Ds) (replicate nwits As) bnf); |
642 |
642 |
643 fun wit_tac {context = ctxt, prems = _} = |
643 fun wit_tac ctxt = |
644 mk_simple_wit_tac (map (unfold_all ctxt) (wit_thms_of_bnf bnf)); |
644 mk_simple_wit_tac (map (unfold_all ctxt) (wit_thms_of_bnf bnf)); |
645 |
645 |
646 val (bnf', lthy') = |
646 val (bnf', lthy') = |
647 bnf_def Hardly_Inline (user_policy Dont_Note) qualify tacs wit_tac (SOME deads) |
647 bnf_def Hardly_Inline (user_policy Dont_Note) qualify tacs wit_tac (SOME deads) |
648 Binding.empty Binding.empty [] |
648 Binding.empty Binding.empty [] |