138 val (bT as Type (b, []), _) = dest_permT U |
138 val (bT as Type (b, []), _) = dest_permT U |
139 in if aT mem permTs_of u andalso aT <> bT then |
139 in if aT mem permTs_of u andalso aT <> bT then |
140 let |
140 let |
141 val a' = Sign.base_name a; |
141 val a' = Sign.base_name a; |
142 val b' = Sign.base_name b; |
142 val b' = Sign.base_name b; |
143 val cp = dynamic_thm thy ("cp_" ^ a' ^ "_" ^ b' ^ "_inst"); |
143 val cp = PureThy.get_thm thy ("cp_" ^ a' ^ "_" ^ b' ^ "_inst"); |
144 val dj = dynamic_thm thy ("dj_" ^ b' ^ "_" ^ a'); |
144 val dj = PureThy.get_thm thy ("dj_" ^ b' ^ "_" ^ a'); |
145 val dj_cp' = [cp, dj] MRS dj_cp; |
145 val dj_cp' = [cp, dj] MRS dj_cp; |
146 val cert = SOME o cterm_of thy |
146 val cert = SOME o cterm_of thy |
147 in |
147 in |
148 SOME (mk_meta_eq (Drule.instantiate' [SOME (ctyp_of thy S)] |
148 SOME (mk_meta_eq (Drule.instantiate' [SOME (ctyp_of thy S)] |
149 [cert t, cert r, cert s] dj_cp')) |
149 [cert t, cert r, cert s] dj_cp')) |
307 |
307 |
308 val _ = warning ("length descr: " ^ string_of_int (length descr)); |
308 val _ = warning ("length descr: " ^ string_of_int (length descr)); |
309 val _ = warning ("length new_type_names: " ^ string_of_int (length new_type_names)); |
309 val _ = warning ("length new_type_names: " ^ string_of_int (length new_type_names)); |
310 |
310 |
311 val perm_indnames = DatatypeProp.make_tnames (map body_type perm_types); |
311 val perm_indnames = DatatypeProp.make_tnames (map body_type perm_types); |
312 val perm_fun_def = dynamic_thm thy2 "perm_fun_def"; |
312 val perm_fun_def = PureThy.get_thm thy2 "perm_fun_def"; |
313 |
313 |
314 val unfolded_perm_eq_thms = |
314 val unfolded_perm_eq_thms = |
315 if length descr = length new_type_names then [] |
315 if length descr = length new_type_names then [] |
316 else map standard (List.drop (split_conj_thm |
316 else map standard (List.drop (split_conj_thm |
317 (Goal.prove_global thy2 [] [] |
317 (Goal.prove_global thy2 [] [] |
351 (**** prove (pi1 @ pi2) \<bullet> t = pi1 \<bullet> (pi2 \<bullet> t) ****) |
351 (**** prove (pi1 @ pi2) \<bullet> t = pi1 \<bullet> (pi2 \<bullet> t) ****) |
352 |
352 |
353 val _ = warning "perm_append_thms"; |
353 val _ = warning "perm_append_thms"; |
354 |
354 |
355 (*FIXME: these should be looked up statically*) |
355 (*FIXME: these should be looked up statically*) |
356 val at_pt_inst = dynamic_thm thy2 "at_pt_inst"; |
356 val at_pt_inst = PureThy.get_thm thy2 "at_pt_inst"; |
357 val pt2 = dynamic_thm thy2 "pt2"; |
357 val pt2 = PureThy.get_thm thy2 "pt2"; |
358 |
358 |
359 val perm_append_thms = List.concat (map (fn a => |
359 val perm_append_thms = List.concat (map (fn a => |
360 let |
360 let |
361 val permT = mk_permT (Type (a, [])); |
361 val permT = mk_permT (Type (a, [])); |
362 val pi1 = Free ("pi1", permT); |
362 val pi1 = Free ("pi1", permT); |
363 val pi2 = Free ("pi2", permT); |
363 val pi2 = Free ("pi2", permT); |
364 val pt_inst = dynamic_thm thy2 ("pt_" ^ Sign.base_name a ^ "_inst"); |
364 val pt_inst = PureThy.get_thm thy2 ("pt_" ^ Sign.base_name a ^ "_inst"); |
365 val pt2' = pt_inst RS pt2; |
365 val pt2' = pt_inst RS pt2; |
366 val pt2_ax = dynamic_thm thy2 (NameSpace.map_base (fn s => "pt_" ^ s ^ "2") a); |
366 val pt2_ax = PureThy.get_thm thy2 (NameSpace.map_base (fn s => "pt_" ^ s ^ "2") a); |
367 in List.take (map standard (split_conj_thm |
367 in List.take (map standard (split_conj_thm |
368 (Goal.prove_global thy2 [] [] |
368 (Goal.prove_global thy2 [] [] |
369 (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj |
369 (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj |
370 (map (fn ((s, T), x) => |
370 (map (fn ((s, T), x) => |
371 let val perm = Const (s, permT --> T --> T) |
371 let val perm = Const (s, permT --> T --> T) |
383 |
383 |
384 (**** prove pi1 ~ pi2 ==> pi1 \<bullet> t = pi2 \<bullet> t ****) |
384 (**** prove pi1 ~ pi2 ==> pi1 \<bullet> t = pi2 \<bullet> t ****) |
385 |
385 |
386 val _ = warning "perm_eq_thms"; |
386 val _ = warning "perm_eq_thms"; |
387 |
387 |
388 val pt3 = dynamic_thm thy2 "pt3"; |
388 val pt3 = PureThy.get_thm thy2 "pt3"; |
389 val pt3_rev = dynamic_thm thy2 "pt3_rev"; |
389 val pt3_rev = PureThy.get_thm thy2 "pt3_rev"; |
390 |
390 |
391 val perm_eq_thms = List.concat (map (fn a => |
391 val perm_eq_thms = List.concat (map (fn a => |
392 let |
392 let |
393 val permT = mk_permT (Type (a, [])); |
393 val permT = mk_permT (Type (a, [])); |
394 val pi1 = Free ("pi1", permT); |
394 val pi1 = Free ("pi1", permT); |
395 val pi2 = Free ("pi2", permT); |
395 val pi2 = Free ("pi2", permT); |
396 (*FIXME: not robust - better access these theorems using NominalData?*) |
396 (*FIXME: not robust - better access these theorems using NominalData?*) |
397 val at_inst = dynamic_thm thy2 ("at_" ^ Sign.base_name a ^ "_inst"); |
397 val at_inst = PureThy.get_thm thy2 ("at_" ^ Sign.base_name a ^ "_inst"); |
398 val pt_inst = dynamic_thm thy2 ("pt_" ^ Sign.base_name a ^ "_inst"); |
398 val pt_inst = PureThy.get_thm thy2 ("pt_" ^ Sign.base_name a ^ "_inst"); |
399 val pt3' = pt_inst RS pt3; |
399 val pt3' = pt_inst RS pt3; |
400 val pt3_rev' = at_inst RS (pt_inst RS pt3_rev); |
400 val pt3_rev' = at_inst RS (pt_inst RS pt3_rev); |
401 val pt3_ax = dynamic_thm thy2 (NameSpace.map_base (fn s => "pt_" ^ s ^ "3") a); |
401 val pt3_ax = PureThy.get_thm thy2 (NameSpace.map_base (fn s => "pt_" ^ s ^ "3") a); |
402 in List.take (map standard (split_conj_thm |
402 in List.take (map standard (split_conj_thm |
403 (Goal.prove_global thy2 [] [] (Logic.mk_implies |
403 (Goal.prove_global thy2 [] [] (Logic.mk_implies |
404 (HOLogic.mk_Trueprop (Const ("Nominal.prm_eq", |
404 (HOLogic.mk_Trueprop (Const ("Nominal.prm_eq", |
405 permT --> permT --> HOLogic.boolT) $ pi1 $ pi2), |
405 permT --> permT --> HOLogic.boolT) $ pi1 $ pi2), |
406 HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj |
406 HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj |
417 length new_type_names) |
417 length new_type_names) |
418 end) atoms); |
418 end) atoms); |
419 |
419 |
420 (**** prove pi1 \<bullet> (pi2 \<bullet> t) = (pi1 \<bullet> pi2) \<bullet> (pi1 \<bullet> t) ****) |
420 (**** prove pi1 \<bullet> (pi2 \<bullet> t) = (pi1 \<bullet> pi2) \<bullet> (pi1 \<bullet> t) ****) |
421 |
421 |
422 val cp1 = dynamic_thm thy2 "cp1"; |
422 val cp1 = PureThy.get_thm thy2 "cp1"; |
423 val dj_cp = dynamic_thm thy2 "dj_cp"; |
423 val dj_cp = PureThy.get_thm thy2 "dj_cp"; |
424 val pt_perm_compose = dynamic_thm thy2 "pt_perm_compose"; |
424 val pt_perm_compose = PureThy.get_thm thy2 "pt_perm_compose"; |
425 val pt_perm_compose_rev = dynamic_thm thy2 "pt_perm_compose_rev"; |
425 val pt_perm_compose_rev = PureThy.get_thm thy2 "pt_perm_compose_rev"; |
426 val dj_perm_perm_forget = dynamic_thm thy2 "dj_perm_perm_forget"; |
426 val dj_perm_perm_forget = PureThy.get_thm thy2 "dj_perm_perm_forget"; |
427 |
427 |
428 fun composition_instance name1 name2 thy = |
428 fun composition_instance name1 name2 thy = |
429 let |
429 let |
430 val name1' = Sign.base_name name1; |
430 val name1' = Sign.base_name name1; |
431 val name2' = Sign.base_name name2; |
431 val name2' = Sign.base_name name2; |
433 val permT1 = mk_permT (Type (name1, [])); |
433 val permT1 = mk_permT (Type (name1, [])); |
434 val permT2 = mk_permT (Type (name2, [])); |
434 val permT2 = mk_permT (Type (name2, [])); |
435 val augment = map_type_tfree |
435 val augment = map_type_tfree |
436 (fn (x, S) => TFree (x, cp_class :: S)); |
436 (fn (x, S) => TFree (x, cp_class :: S)); |
437 val Ts = map (augment o body_type) perm_types; |
437 val Ts = map (augment o body_type) perm_types; |
438 val cp_inst = dynamic_thm thy ("cp_" ^ name1' ^ "_" ^ name2' ^ "_inst"); |
438 val cp_inst = PureThy.get_thm thy ("cp_" ^ name1' ^ "_" ^ name2' ^ "_inst"); |
439 val simps = simpset_of thy addsimps (perm_fun_def :: |
439 val simps = simpset_of thy addsimps (perm_fun_def :: |
440 (if name1 <> name2 then |
440 (if name1 <> name2 then |
441 let val dj = dynamic_thm thy ("dj_" ^ name2' ^ "_" ^ name1') |
441 let val dj = PureThy.get_thm thy ("dj_" ^ name2' ^ "_" ^ name1') |
442 in [dj RS (cp_inst RS dj_cp), dj RS dj_perm_perm_forget] end |
442 in [dj RS (cp_inst RS dj_cp), dj RS dj_perm_perm_forget] end |
443 else |
443 else |
444 let |
444 let |
445 val at_inst = dynamic_thm thy ("at_" ^ name1' ^ "_inst"); |
445 val at_inst = PureThy.get_thm thy ("at_" ^ name1' ^ "_inst"); |
446 val pt_inst = dynamic_thm thy ("pt_" ^ name1' ^ "_inst"); |
446 val pt_inst = PureThy.get_thm thy ("pt_" ^ name1' ^ "_inst"); |
447 in |
447 in |
448 [cp_inst RS cp1 RS sym, |
448 [cp_inst RS cp1 RS sym, |
449 at_inst RS (pt_inst RS pt_perm_compose) RS sym, |
449 at_inst RS (pt_inst RS pt_perm_compose) RS sym, |
450 at_inst RS (pt_inst RS pt_perm_compose_rev) RS sym] |
450 at_inst RS (pt_inst RS pt_perm_compose_rev) RS sym] |
451 end)) |
451 end)) |
569 |
569 |
570 (**** Prove that representing set is closed under permutation ****) |
570 (**** Prove that representing set is closed under permutation ****) |
571 |
571 |
572 val _ = warning "proving closure under permutation..."; |
572 val _ = warning "proving closure under permutation..."; |
573 |
573 |
574 val abs_perm = dynamic_thms thy4 "abs_perm"; |
574 val abs_perm = PureThy.get_thms thy4 "abs_perm"; |
575 |
575 |
576 val perm_indnames' = List.mapPartial |
576 val perm_indnames' = List.mapPartial |
577 (fn (x, (_, ("Nominal.noption", _, _))) => NONE | (x, _) => SOME x) |
577 (fn (x, (_, ("Nominal.noption", _, _))) => NONE | (x, _) => SOME x) |
578 (perm_indnames ~~ descr); |
578 (perm_indnames ~~ descr); |
579 |
579 |
654 (EVERY [Class.intro_classes_tac [], |
654 (EVERY [Class.intro_classes_tac [], |
655 rewrite_goals_tac [perm_def], |
655 rewrite_goals_tac [perm_def], |
656 asm_full_simp_tac (simpset_of thy addsimps [Rep_inverse]) 1, |
656 asm_full_simp_tac (simpset_of thy addsimps [Rep_inverse]) 1, |
657 asm_full_simp_tac (simpset_of thy addsimps |
657 asm_full_simp_tac (simpset_of thy addsimps |
658 [Rep RS perm_closed RS Abs_inverse]) 1, |
658 [Rep RS perm_closed RS Abs_inverse]) 1, |
659 asm_full_simp_tac (HOL_basic_ss addsimps [dynamic_thm thy |
659 asm_full_simp_tac (HOL_basic_ss addsimps [PureThy.get_thm thy |
660 ("pt_" ^ Sign.base_name atom ^ "3")]) 1]) thy) |
660 ("pt_" ^ Sign.base_name atom ^ "3")]) 1]) thy) |
661 (Abs_inverse_thms ~~ Rep_inverse_thms ~~ Rep_thms ~~ perm_defs ~~ |
661 (Abs_inverse_thms ~~ Rep_inverse_thms ~~ Rep_thms ~~ perm_defs ~~ |
662 new_type_names ~~ tyvars ~~ perm_closed_thms); |
662 new_type_names ~~ tyvars ~~ perm_closed_thms); |
663 |
663 |
664 |
664 |
668 |
668 |
669 fun cp_instance (atom1, perm_closed_thms1) (atom2, perm_closed_thms2) thy = |
669 fun cp_instance (atom1, perm_closed_thms1) (atom2, perm_closed_thms2) thy = |
670 let |
670 let |
671 val name = "cp_" ^ Sign.base_name atom1 ^ "_" ^ Sign.base_name atom2; |
671 val name = "cp_" ^ Sign.base_name atom1 ^ "_" ^ Sign.base_name atom2; |
672 val class = Sign.intern_class thy name; |
672 val class = Sign.intern_class thy name; |
673 val cp1' = dynamic_thm thy (name ^ "_inst") RS cp1 |
673 val cp1' = PureThy.get_thm thy (name ^ "_inst") RS cp1 |
674 in fold (fn ((((((Abs_inverse, Rep), |
674 in fold (fn ((((((Abs_inverse, Rep), |
675 perm_def), name), tvs), perm_closed1), perm_closed2) => fn thy => |
675 perm_def), name), tvs), perm_closed1), perm_closed2) => fn thy => |
676 AxClass.prove_arity |
676 AxClass.prove_arity |
677 (Sign.intern_type thy name, |
677 (Sign.intern_type thy name, |
678 replicate (length tvs) (classes @ cp_classes), [class]) |
678 replicate (length tvs) (classes @ cp_classes), [class]) |
918 end) (List.take (pdescr, length new_type_names) ~~ new_type_names ~~ constr_rep_thmss); |
918 end) (List.take (pdescr, length new_type_names) ~~ new_type_names ~~ constr_rep_thmss); |
919 |
919 |
920 (** prove injectivity of constructors **) |
920 (** prove injectivity of constructors **) |
921 |
921 |
922 val rep_inject_thms' = map (fn th => th RS sym) rep_inject_thms; |
922 val rep_inject_thms' = map (fn th => th RS sym) rep_inject_thms; |
923 val alpha = dynamic_thms thy8 "alpha"; |
923 val alpha = PureThy.get_thms thy8 "alpha"; |
924 val abs_fresh = dynamic_thms thy8 "abs_fresh"; |
924 val abs_fresh = PureThy.get_thms thy8 "abs_fresh"; |
925 |
925 |
926 val inject_thms = map (fn (((i, (_, _, constrs)), tname), constr_rep_thms) => |
926 val inject_thms = map (fn (((i, (_, _, constrs)), tname), constr_rep_thms) => |
927 let val T = nth_dtyp' i |
927 let val T = nth_dtyp' i |
928 in List.mapPartial (fn ((cname, dts), constr_rep_thm) => |
928 in List.mapPartial (fn ((cname, dts), constr_rep_thm) => |
929 if null dts then NONE else SOME |
929 if null dts then NONE else SOME |
1064 |
1064 |
1065 val _ = warning "proving finite support for the new datatype"; |
1065 val _ = warning "proving finite support for the new datatype"; |
1066 |
1066 |
1067 val indnames = DatatypeProp.make_tnames recTs; |
1067 val indnames = DatatypeProp.make_tnames recTs; |
1068 |
1068 |
1069 val abs_supp = dynamic_thms thy8 "abs_supp"; |
1069 val abs_supp = PureThy.get_thms thy8 "abs_supp"; |
1070 val supp_atm = dynamic_thms thy8 "supp_atm"; |
1070 val supp_atm = PureThy.get_thms thy8 "supp_atm"; |
1071 |
1071 |
1072 val finite_supp_thms = map (fn atom => |
1072 val finite_supp_thms = map (fn atom => |
1073 let val atomT = Type (atom, []) |
1073 let val atomT = Type (atom, []) |
1074 in map standard (List.take |
1074 in map standard (List.take |
1075 (split_conj_thm (Goal.prove_global thy8 [] [] (HOLogic.mk_Trueprop |
1075 (split_conj_thm (Goal.prove_global thy8 [] [] (HOLogic.mk_Trueprop |
1078 (Const ("Nominal.supp", T --> HOLogic.mk_setT atomT) $ Free (s, T))) |
1078 (Const ("Nominal.supp", T --> HOLogic.mk_setT atomT) $ Free (s, T))) |
1079 (indnames ~~ recTs)))) |
1079 (indnames ~~ recTs)))) |
1080 (fn _ => indtac dt_induct indnames 1 THEN |
1080 (fn _ => indtac dt_induct indnames 1 THEN |
1081 ALLGOALS (asm_full_simp_tac (simpset_of thy8 addsimps |
1081 ALLGOALS (asm_full_simp_tac (simpset_of thy8 addsimps |
1082 (abs_supp @ supp_atm @ |
1082 (abs_supp @ supp_atm @ |
1083 dynamic_thms thy8 ("fs_" ^ Sign.base_name atom ^ "1") @ |
1083 PureThy.get_thms thy8 ("fs_" ^ Sign.base_name atom ^ "1") @ |
1084 List.concat supp_thms))))), |
1084 List.concat supp_thms))))), |
1085 length new_type_names)) |
1085 length new_type_names)) |
1086 end) atoms; |
1086 end) atoms; |
1087 |
1087 |
1088 val simp_atts = replicate (length new_type_names) [Simplifier.simp_add]; |
1088 val simp_atts = replicate (length new_type_names) [Simplifier.simp_add]; |
1205 fold_rev (mk_perm aux_ind_Ts) (map Bound (length dt_atomTs downto 1)) |
1205 fold_rev (mk_perm aux_ind_Ts) (map Bound (length dt_atomTs downto 1)) |
1206 (Free (tname, T)))) |
1206 (Free (tname, T)))) |
1207 (descr'' ~~ recTs ~~ tnames))); |
1207 (descr'' ~~ recTs ~~ tnames))); |
1208 |
1208 |
1209 val fin_set_supp = map (fn Type (s, _) => |
1209 val fin_set_supp = map (fn Type (s, _) => |
1210 dynamic_thm thy9 ("at_" ^ Sign.base_name s ^ "_inst") RS |
1210 PureThy.get_thm thy9 ("at_" ^ Sign.base_name s ^ "_inst") RS |
1211 at_fin_set_supp) dt_atomTs; |
1211 at_fin_set_supp) dt_atomTs; |
1212 val fin_set_fresh = map (fn Type (s, _) => |
1212 val fin_set_fresh = map (fn Type (s, _) => |
1213 dynamic_thm thy9 ("at_" ^ Sign.base_name s ^ "_inst") RS |
1213 PureThy.get_thm thy9 ("at_" ^ Sign.base_name s ^ "_inst") RS |
1214 at_fin_set_fresh) dt_atomTs; |
1214 at_fin_set_fresh) dt_atomTs; |
1215 val pt1_atoms = map (fn Type (s, _) => |
1215 val pt1_atoms = map (fn Type (s, _) => |
1216 dynamic_thm thy9 ("pt_" ^ Sign.base_name s ^ "1")) dt_atomTs; |
1216 PureThy.get_thm thy9 ("pt_" ^ Sign.base_name s ^ "1")) dt_atomTs; |
1217 val pt2_atoms = map (fn Type (s, _) => |
1217 val pt2_atoms = map (fn Type (s, _) => |
1218 dynamic_thm thy9 ("pt_" ^ Sign.base_name s ^ "2") RS sym) dt_atomTs; |
1218 PureThy.get_thm thy9 ("pt_" ^ Sign.base_name s ^ "2") RS sym) dt_atomTs; |
1219 val exists_fresh' = dynamic_thms thy9 "exists_fresh'"; |
1219 val exists_fresh' = PureThy.get_thms thy9 "exists_fresh'"; |
1220 val fs_atoms = dynamic_thms thy9 "fin_supp"; |
1220 val fs_atoms = PureThy.get_thms thy9 "fin_supp"; |
1221 val abs_supp = dynamic_thms thy9 "abs_supp"; |
1221 val abs_supp = PureThy.get_thms thy9 "abs_supp"; |
1222 val perm_fresh_fresh = dynamic_thms thy9 "perm_fresh_fresh"; |
1222 val perm_fresh_fresh = PureThy.get_thms thy9 "perm_fresh_fresh"; |
1223 val calc_atm = dynamic_thms thy9 "calc_atm"; |
1223 val calc_atm = PureThy.get_thms thy9 "calc_atm"; |
1224 val fresh_atm = dynamic_thms thy9 "fresh_atm"; |
1224 val fresh_atm = PureThy.get_thms thy9 "fresh_atm"; |
1225 val fresh_left = dynamic_thms thy9 "fresh_left"; |
1225 val fresh_left = PureThy.get_thms thy9 "fresh_left"; |
1226 val perm_swap = dynamic_thms thy9 "perm_swap"; |
1226 val perm_swap = PureThy.get_thms thy9 "perm_swap"; |
1227 |
1227 |
1228 fun obtain_fresh_name' ths ts T (freshs1, freshs2, ctxt) = |
1228 fun obtain_fresh_name' ths ts T (freshs1, freshs2, ctxt) = |
1229 let |
1229 let |
1230 val p = foldr1 HOLogic.mk_prod (ts @ freshs1); |
1230 val p = foldr1 HOLogic.mk_prod (ts @ freshs1); |
1231 val ex = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop |
1231 val ex = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop |
1494 PureThy.hide_thms true [NameSpace.append |
1494 PureThy.hide_thms true [NameSpace.append |
1495 (Sign.full_name thy10 big_rec_name) "induct"]; |
1495 (Sign.full_name thy10 big_rec_name) "induct"]; |
1496 |
1496 |
1497 (** equivariance **) |
1497 (** equivariance **) |
1498 |
1498 |
1499 val fresh_bij = dynamic_thms thy11 "fresh_bij"; |
1499 val fresh_bij = PureThy.get_thms thy11 "fresh_bij"; |
1500 val perm_bij = dynamic_thms thy11 "perm_bij"; |
1500 val perm_bij = PureThy.get_thms thy11 "perm_bij"; |
1501 |
1501 |
1502 val (rec_equiv_thms, rec_equiv_thms') = ListPair.unzip (map (fn aT => |
1502 val (rec_equiv_thms, rec_equiv_thms') = ListPair.unzip (map (fn aT => |
1503 let |
1503 let |
1504 val permT = mk_permT aT; |
1504 val permT = mk_permT aT; |
1505 val pi = Free ("pi", permT); |
1505 val pi = Free ("pi", permT); |
1533 (** finite support **) |
1533 (** finite support **) |
1534 |
1534 |
1535 val rec_fin_supp_thms = map (fn aT => |
1535 val rec_fin_supp_thms = map (fn aT => |
1536 let |
1536 let |
1537 val name = Sign.base_name (fst (dest_Type aT)); |
1537 val name = Sign.base_name (fst (dest_Type aT)); |
1538 val fs_name = dynamic_thm thy11 ("fs_" ^ name ^ "1"); |
1538 val fs_name = PureThy.get_thm thy11 ("fs_" ^ name ^ "1"); |
1539 val aset = HOLogic.mk_setT aT; |
1539 val aset = HOLogic.mk_setT aT; |
1540 val finite = Const ("Finite_Set.finite", aset --> HOLogic.boolT); |
1540 val finite = Const ("Finite_Set.finite", aset --> HOLogic.boolT); |
1541 val fins = map (fn (f, T) => HOLogic.mk_Trueprop |
1541 val fins = map (fn (f, T) => HOLogic.mk_Trueprop |
1542 (finite $ (Const ("Nominal.supp", T --> aset) $ f))) |
1542 (finite $ (Const ("Nominal.supp", T --> aset) $ f))) |
1543 (rec_fns ~~ rec_fn_Ts) |
1543 (rec_fns ~~ rec_fn_Ts) |
1566 (rec_fns ~~ rec_fn_Ts)) dt_atomTs; |
1566 (rec_fns ~~ rec_fn_Ts)) dt_atomTs; |
1567 |
1567 |
1568 val rec_fresh_thms = map (fn ((aT, eqvt_ths), finite_prems) => |
1568 val rec_fresh_thms = map (fn ((aT, eqvt_ths), finite_prems) => |
1569 let |
1569 let |
1570 val name = Sign.base_name (fst (dest_Type aT)); |
1570 val name = Sign.base_name (fst (dest_Type aT)); |
1571 val fs_name = dynamic_thm thy11 ("fs_" ^ name ^ "1"); |
1571 val fs_name = PureThy.get_thm thy11 ("fs_" ^ name ^ "1"); |
1572 val a = Free ("a", aT); |
1572 val a = Free ("a", aT); |
1573 val freshs = map (fn (f, fT) => HOLogic.mk_Trueprop |
1573 val freshs = map (fn (f, fT) => HOLogic.mk_Trueprop |
1574 (fresh_const aT fT $ a $ f)) (rec_fns ~~ rec_fn_Ts) |
1574 (fresh_const aT fT $ a $ f)) (rec_fns ~~ rec_fn_Ts) |
1575 in |
1575 in |
1576 map (fn (((T, U), R), eqvt_th) => |
1576 map (fn (((T, U), R), eqvt_th) => |